home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / WindowMaker / WMSupport.2 < prev   
Text File  |  1993-07-24  |  87KB  |  2,069 lines

  1. "Copyright WilfLalonde, The Object People"!
  2.  
  3. Smalltalk garbageCollect!
  4.  
  5. Object subclass: #ErrorHandler
  6.     instanceVariableNames: 'errorBlock '
  7.     classVariableNames: ''
  8.     poolDictionaries: ''
  9.     category: 'WindowMakerSupport'!
  10.  
  11. !ErrorHandler methodsFor: 'instance initialization'!
  12. errorBlock: aBlock
  13.     errorBlock _ aBlock! !
  14.  
  15. !ErrorHandler methodsFor: 'error handling'!
  16. deselect
  17.     "Ignore"!
  18. notify: aString at: anInteger in: aStream
  19.     errorBlock value: aString value: anInteger!
  20. select
  21.     "Ignore"!
  22. selectFrom: start to: end
  23.     "Ignore"!
  24. selectInvisiblyFrom: start to: end
  25.     "Ignore"!
  26. selectionInterval
  27.     ^1 to: 0! !
  28.  
  29.  
  30. View subclass: #ExtendedExternalView
  31.     instanceVariableNames: 'name className newMessage '
  32.     classVariableNames: ''
  33.     poolDictionaries: ''
  34.     category: 'WindowMakerSupport'!
  35.  
  36. !ExtendedExternalView methodsFor: 'instance initialization'!
  37. external: anArray
  38.     "Initializes the external view by obtaining the subview denoted by the parameter: anArray having the form #(className selectorOrMessage). The external view's inset window and the subview's viewport must be made to correspond. Two solutions are possible: (1) make the external view's inset window the same as the subview's viewport or (2) make the subview's viewport the same as the external view's inset window. Solution (1) is used here. This leaves the subview unaffected."
  39.     | class subview |
  40.     className _ anArray at: 1. newMessage _ anArray at: 2.
  41.     class _ Smalltalk at: className.
  42.     subview _ WindowMaker asView: ((newMessage isKindOf: Message)
  43.         ifTrue: [newMessage sendTo: class]
  44.         ifFalse: [class perform: newMessage]).
  45.     self addSubView: subview.
  46.     self window: (subview getViewport expandBy: self borderWidth) viewport: self getViewport.! !
  47.  
  48. !ExtendedExternalView methodsFor: 'name'!
  49. name
  50.     ^name!
  51. name: aSymbolOrNil
  52.     name _ aSymbolOrNil!
  53. viewNamed: aSymbol
  54.     | answer |
  55.     name == aSymbol ifTrue: [^self].
  56.     subViews do: [:aView | 
  57.         answer _ aView viewNamed: aSymbol. 
  58.         answer isNil ifFalse: [^answer]].
  59.     ^nil! !
  60.  
  61. !ExtendedExternalView methodsFor: 'model'!
  62. models: anObject
  63.     "If this view's model is nil, changes it to anObject and repeats the process for all subviews; otherwise, does nothing."
  64.     model isNil ifFalse: [^self].
  65.     self model: anObject.
  66.     subViews do: [:aView | aView models: anObject]!
  67. resetModels
  68.     "Sets this view's model to nil and repeats for all subviews."
  69.     self model: nil.
  70.     subViews do: [:aView | aView resetModels]! !
  71.  
  72. !ExtendedExternalView methodsFor: 'copying'!
  73. deepCopy
  74.     | copy |
  75.     copy _ self shallowCopy
  76.         superView: nil; resetSubViews;
  77.         model: model deepCopy controller: nil;
  78.         transformation: transformation "stores a copy";
  79.         window: window "stores a copy";
  80.         yourself.
  81.     subViews do: [:aView | copy addSubView: aView deepCopy].
  82.     ^copy! !
  83.  
  84. !ExtendedExternalView methodsFor: 'displaying'!
  85. computeDisplayTransformation
  86.     "Since the borders in the containing view do not actually scale, this view (if left unchanged) will be positioned at a point that assumes the borders did scale. This can be eliminated by transforming into the inset display box rather than the display box. See View | computeDisplayTransformation for the difference."
  87.  
  88.     self isTopView
  89.         ifTrue: [^transformation]
  90.         ifFalse: [^superView insetDisplayTransformation compose: transformation]!
  91. insetDisplayTransformation
  92.     "Ignores the borders."
  93.     ^WindowingTransformation
  94.         window: self insetWindow
  95.         viewport: self insetDisplayBox! !
  96.  
  97. !ExtendedExternalView methodsFor: 'printing'!
  98. storeOn: aStream
  99.     self storeOn: aStream indent: 2!
  100. storeOn: aStream indent: indentation
  101.     "Store this instance of an ExtendedView with indentation for readability."
  102.     | return continue |
  103.     return _ (WriteStream on: (String new: 16)) crtab: indentation; contents.
  104.     continue _ ';', return.
  105.     aStream
  106.         nextPutAll: '(ExtendedExternalView new'; nextPutAll: return;
  107.         nextPutAll: 'name: '; store: name; nextPutAll: continue;
  108.         nextPutAll: 'insideColor: '. ExtendedStandardSystemView storeInsideColor: insideColor on: aStream.
  109.             aStream nextPutAll: continue.
  110.         ExtendedStandardSystemView storeBorderWidth: borderWidth messageOn: aStream.
  111.             aStream nextPutAll: continue;
  112.         nextPutAll: 'window: '; store: window; nextPutAll: continue;
  113.         nextPutAll: 'transformation: ('; print: transformation; nextPut: $); nextPutAll: continue;
  114.         nextPutAll: 'external: '; store: (Array with: className with: newMessage); nextPutAll: continue;
  115.         nextPutAll: 'yourself)'! !
  116.  
  117.  
  118. SelectionInListController subclass: #ExtendedMenuController
  119.     instanceVariableNames: ''
  120.     classVariableNames: ''
  121.     poolDictionaries: ''
  122.     category: 'WindowMakerSupport'!
  123.  
  124. !ExtendedMenuController methodsFor: 'control defaults'!
  125. isControlWanted
  126.     ^self viewHasCursor! !
  127.  
  128.  
  129. SelectionInListView subclass: #ExtendedMenuView
  130.     instanceVariableNames: 'name updateInProgress ignoreChangeMessage '
  131.     classVariableNames: ''
  132.     poolDictionaries: ''
  133.     category: 'WindowMakerSupport'!
  134.  
  135. !ExtendedMenuView methodsFor: 'initialization'!
  136. on: anObject printItems: flag1 oneItem: flag2 aspect: m1 change: m2 list: m3 menu: m4 initialSelection: m5
  137.     "Override SelectionInListView to avoid getting and changing the initial list until after the view is opened."
  138.     self model: anObject.
  139.     printItems _ flag1. oneItem _ flag2.
  140.     partMsg _ m1. changeMsg _ m2. listMsg _ m3. menuMsg _ m4. initialSelectionMsg _ m5.
  141.     oneItem ifTrue: [
  142.         self noTopDelimiter noBottomDelimiter.
  143.         initialSelectionMsg == nil ifTrue: [
  144.             self error: 'initialSelection must be specified for oneItem mode']].
  145.     "Commented out the following: 
  146.     self list: self getList
  147.     "! !
  148.  
  149. !ExtendedMenuView methodsFor: 'name'!
  150. name
  151.     ^name!
  152. name: aSymbolOrNil
  153.     name _ aSymbolOrNil!
  154. viewNamed: aSymbol
  155.     name == aSymbol ifTrue: [^self] ifFalse: [^nil]! !
  156.  
  157. !ExtendedMenuView methodsFor: 'model'!
  158. models: anObject
  159.     "If this view's model is nil, changes it to anObject; otherwise, does nothing."
  160.     model isNil ifFalse: [^self].
  161.     self model: anObject!
  162. resetModels
  163.     "Sets this view's model to nil."
  164.     self model: nil! !
  165.  
  166. !ExtendedMenuView methodsFor: 'controller'!
  167. defaultControllerClass
  168.     ^ExtendedMenuController! !
  169.  
  170. !ExtendedMenuView methodsFor: 'list access'!
  171. list: anArray
  172.     "Eliminate built-in update in progress loop; more specifically, avoid changing the list selection to what it is."
  173.     ignoreChangeMessage _ true.
  174.     super list: anArray.
  175.     ignoreChangeMessage _ nil! !
  176.  
  177. !ExtendedMenuView methodsFor: 'updating'!
  178. aspect: aSymbol
  179.     partMsg _ aSymbol!
  180. update: aSymbol
  181.     "Upward compatible with selectionInList views."
  182.  
  183.     updateInProgress isNil ifFalse: [^self].
  184.     updateInProgress _ true.
  185.     super update: aSymbol.
  186.     updateInProgress _ nil! !
  187.  
  188. !ExtendedMenuView methodsFor: 'adaptor'!
  189. changeModelSelection: anInteger
  190.     "Get the new menu list's selection unless requested not to do so."
  191.     | newSelection |
  192.     ignoreChangeMessage isNil ifFalse: [^self].
  193.     self controller controlTerminate.
  194.         (changeMsg isKindOf: Message) 
  195.             ifTrue: [
  196.                 newSelection _ anInteger = 0 ifTrue: [nil] ifFalse: [itemList at: anInteger].
  197.                 changeMsg sendTo: model replacingParameter: 1 by: newSelection]
  198.             ifFalse: [^super changeModelSelection: anInteger].
  199.     self controller controlInitialize!
  200. getList
  201.     (listMsg isKindOf: Message) ifTrue: [^listMsg sendTo: model].
  202.     ^super getList!
  203. initialSelection
  204.     (initialSelectionMsg isKindOf: Message) ifTrue: [^initialSelectionMsg sendTo: model].
  205.     ^super initialSelection!
  206. yellowButtonMenu
  207.     (menuMsg isKindOf: Message) ifTrue: [^menuMsg sendTo: model].
  208.     ^super yellowButtonMenu! !
  209.  
  210. !ExtendedMenuView methodsFor: 'copying'!
  211. deepCopy
  212.     ^self shallowCopy
  213.         superView: nil; resetSubViews;
  214.         model: model deepCopy controller: nil;
  215.         transformation: transformation "stores a copy";
  216.         window: window "stores a copy";
  217.         yourself! !
  218.  
  219. !ExtendedMenuView methodsFor: 'displaying'!
  220. computeDisplayTransformation
  221.     "Since the borders in the containing view do not actually scale, this view (if left unchanged) will be positioned at a point that assumes the borders did scale. This can be eliminated by transforming into the inset display box rather than the display box. See View | computeDisplayTransformation for the difference."
  222.  
  223.     self isTopView
  224.         ifTrue: [^transformation]
  225.         ifFalse: [^superView insetDisplayTransformation compose: transformation]!
  226. displayView
  227.     "Ensure that the item list is set up when the view is first displayed."
  228.     itemList size = 0 ifTrue: [self list: self getList].
  229.     super displayView!
  230. insetDisplayTransformation
  231.     "Ignores the borders."
  232.     ^WindowingTransformation
  233.         window: self insetWindow
  234.         viewport: self insetDisplayBox! !
  235.  
  236. !ExtendedMenuView methodsFor: 'printing'!
  237. storeOn: aStream
  238.     self storeOn: aStream indent: 2!
  239. storeOn: aStream indent: indentation
  240.     "Store this instance of an ExtendedMenuView with indentation for readability."
  241.     | return continue |
  242.     return _ (WriteStream on: (String new: 16)) crtab: indentation; contents.
  243.     continue _ ';', return.
  244.     aStream
  245.         nextPutAll: '((ExtendedMenuView on: nil'; nextPutAll: return;
  246.         nextPutAll: 'printItems: true oneItem: false'; nextPutAll: return;
  247.         nextPutAll: 'aspect: '; store: partMsg; nextPutAll: return;
  248.         nextPutAll: 'change: '; store: changeMsg; nextPutAll: return;
  249.         nextPutAll: 'list: '; store: listMsg; nextPutAll: return;
  250.         nextPutAll: 'menu: '; store: menuMsg; nextPutAll: return;
  251.         nextPutAll: 'initialSelection: '; store: initialSelectionMsg; nextPut: $); nextPutAll: return;
  252.         nextPutAll: 'name: '; store: name; nextPutAll: continue;
  253.         nextPutAll: 'insideColor: '. ExtendedStandardSystemView storeInsideColor: insideColor on: aStream.
  254.             aStream nextPutAll: continue.
  255.         ExtendedStandardSystemView storeBorderWidth: borderWidth messageOn: aStream.
  256.             aStream nextPutAll: continue;
  257.         nextPutAll: 'window: '; store: window; nextPutAll: continue;
  258.         nextPutAll: 'transformation: ('; print: transformation; nextPut: $); nextPutAll: continue;
  259.         nextPutAll: 'yourself)'! !
  260.  
  261.  
  262. Message subclass: #ExtendedMessage
  263.     instanceVariableNames: ''
  264.     classVariableNames: ''
  265.     poolDictionaries: ''
  266.     category: 'WindowMakerSupport'!
  267.  
  268. !ExtendedMessage methodsFor: 'sending'!
  269. sendTo: receiver
  270.     ^receiver perform: selector withArguments: args!
  271. sendTo: receiver replacingParameter: anInteger by: anObject
  272.     ^receiver 
  273.         perform: selector 
  274.         withArguments: (args copyReplaceFrom: anInteger to: anInteger with: (Array with: anObject))! !
  275.  
  276. !ExtendedMessage methodsFor: 'printing'!
  277. storeOn: aStream  
  278.     "Same as Message storeOn: but with the class name changed."
  279.  
  280.     aStream 
  281.         nextPut: $(; nextPutAll: self class name; 
  282.         nextPutAll: ' selector: '; store: selector;
  283.         nextPutAll: ' arguments: '; store: args;
  284.         nextPut: $)! !
  285.  
  286.  
  287. StandardSystemView subclass: #ExtendedStandardSystemView
  288.     instanceVariableNames: 'name preOpeningSelector postClosingSelector encoding '
  289.     classVariableNames: 'CompilationHeuristic '
  290.     poolDictionaries: ''
  291.     category: 'WindowMakerSupport'!
  292.  
  293. !ExtendedStandardSystemView methodsFor: 'name'!
  294. name
  295.     ^name!
  296. name: aSymbolOrNil
  297.     name _ aSymbolOrNil!
  298. viewNamed: aSymbol
  299.     | answer |
  300.     name == aSymbol ifTrue: [^self].
  301.     subViews do: [:aView | 
  302.         answer _ aView viewNamed: aSymbol. 
  303.         answer isNil ifFalse: [^answer]].
  304.     ^nil! !
  305.  
  306. !ExtendedStandardSystemView methodsFor: 'model'!
  307. models: anObject
  308.     "If this view's model is nil, changes it to anObject and repeats the process for all subviews; otherwise, does nothing."
  309.     model isNil ifFalse: [^self].
  310.     self model: anObject.
  311.     subViews do: [:aView | aView models: anObject]!
  312. resetModels
  313.     "Sets this view's model to nil and repeats for all subviews."
  314.     self model: nil.
  315.     subViews do: [:aView | aView resetModels]! !
  316.  
  317. !ExtendedStandardSystemView methodsFor: 'encoding'!
  318. encoding
  319.     ^encoding!
  320. encoding: anArray
  321.     encoding _ anArray! !
  322.  
  323. !ExtendedStandardSystemView methodsFor: 'pre-opening/post-closing selectors'!
  324. postClosingSelector
  325.     ^postClosingSelector!
  326. postClosingSelector: aSymbolOrNil
  327.     postClosingSelector _ aSymbolOrNil!
  328. preOpeningSelector
  329.     ^preOpeningSelector!
  330. preOpeningSelector: aSymbolOrNil
  331.     preOpeningSelector _ aSymbolOrNil! !
  332.  
  333. !ExtendedStandardSystemView methodsFor: 'copying'!
  334. deepCopy
  335.     | copy |
  336.     copy _ self shallowCopy
  337.         superView: nil; resetSubViews;
  338.         model: model deepCopy controller: nil;
  339.         transformation: transformation "stores a copy";
  340.         window: window "stores a copy";
  341.         labelFrame: labelFrame deepCopy;
  342.         label: (labelText isNil ifTrue: [nil] ifFalse: [self label]);
  343.         minimumSize: minimumSize copy;
  344.         maximumSize: maximumSize copy;
  345.         yourself.
  346.     subViews do: [:aView | copy addSubView: aView deepCopy].
  347.     ^copy! !
  348.  
  349. !ExtendedStandardSystemView methodsFor: 'displaying'!
  350. computeDisplayTransformation
  351.     "Since the borders in the containing view do not actually scale, this view (if left unchanged) will be positioned at a point that assumes the borders did scale. This can be eliminated by transforming into the inset display box rather than the display box. See View | computeDisplayTransformation for the difference."
  352.  
  353.     self isTopView
  354.         ifTrue: [^transformation]
  355.         ifFalse: [^superView insetDisplayTransformation compose: transformation]!
  356. insetDisplayTransformation
  357.     "Ignores the borders."
  358.     ^WindowingTransformation
  359.         window: self insetWindow
  360.         viewport: self insetDisplayBox! !
  361.  
  362. !ExtendedStandardSystemView methodsFor: 'printing'!
  363. storeOn: aStream
  364.     self storeOn: aStream indent: 2!
  365. storeOn: aStream encoding: aStringOrNil subViews: aBoolean indent: indentation
  366.     "Store this ExtendedStandardSystemView using indentation for readability. Either generates the encoding or uses the one provided if aStringOrNil is non-nil. Only generates the subviews if aBoolean is true."
  367.  
  368.     | return continue |
  369.     return _ (WriteStream on: (String new: 16)) crtab: indentation; contents.
  370.     continue _ ';', return.
  371.  
  372.     aStream
  373.         nextPutAll: '(ExtendedStandardSystemView new'; nextPutAll: return;
  374.         nextPutAll: 'name: '; store: name; nextPutAll: continue;
  375.         nextPutAll: 'preOpeningSelector: '; store: preOpeningSelector; nextPutAll: continue;
  376.         nextPutAll: 'postClosingSelector: '; store: postClosingSelector; nextPutAll: continue;
  377.         nextPutAll: 'encoding: '.
  378.  
  379.     aStringOrNil isNil
  380.         ifTrue: [ExtendedStandardSystemView storeEncoding: encoding on: aStream 
  381.             indent: indentation+1]
  382.         ifFalse: [aStream nextPutAll: aStringOrNil].
  383.     aStream nextPutAll: continue.
  384.  
  385.     aStream
  386.         nextPutAll: 'label: '; store: self label; nextPutAll: continue;
  387.         nextPutAll: 'minimumSize: '; store: minimumSize; nextPutAll: continue;
  388.         nextPutAll: 'maximumSize: '; store: maximumSize; nextPutAll: continue;
  389.         nextPutAll: 'insideColor: '. ExtendedStandardSystemView storeInsideColor: insideColor on: aStream.
  390.             aStream nextPutAll: continue.
  391.         ExtendedStandardSystemView storeBorderWidth: borderWidth messageOn: aStream.
  392.             aStream nextPutAll: continue;
  393.         nextPutAll: 'window: '; store: window; nextPutAll: continue;
  394.         nextPutAll: 'transformation: ('; print: transformation; nextPut: $); nextPutAll: continue.
  395.  
  396.     aBoolean ifTrue: [
  397.         subViews do: [:subView | 
  398.             aStream nextPutAll: 'addSubView: '.
  399.             subView storeOn: aStream indent: indentation+1.
  400.             aStream nextPutAll: continue]].
  401.  
  402.     aStream nextPutAll: 'yourself)'!
  403. storeOn: aStream indent: indentation
  404.     "Store this instance of an ExtendedStandardSystemView with indentation for readability."
  405.     self storeOn: aStream encoding: nil subViews: true indent: indentation! !
  406.  
  407. !ExtendedStandardSystemView methodsFor: 'compiling'!
  408. compileIntoClass: class method: methodName category: categoryName
  409.     "Compile the receiver into the specified class."
  410.     ExtendedStandardSystemView 
  411.         compile: self intoClass: class method: methodName category: categoryName!
  412. compileIntoClass: class method: methodName category: categoryName overflow: overflowName
  413.     "Compile the receiver into the specified class."
  414.     ExtendedStandardSystemView 
  415.         compile: self intoClass: class method: methodName 
  416.         category: categoryName overFlowCategory: overflowName! !
  417.  
  418. !ExtendedStandardSystemView methodsFor: 'opening/pre-opening'!
  419. open
  420.     preOpeningSelector isNil ifFalse: [
  421.         (preOpeningSelector isKindOf: Message) 
  422.             ifTrue: [preOpeningSelector sendTo: model replacingParameter: 1 by: self]
  423.             ifFalse: [model perform: preOpeningSelector with: self]].
  424.     self controller open!
  425. openOn: aModel
  426.     preOpeningSelector isNil
  427.         ifTrue: [self models: aModel]
  428.         ifFalse: [
  429.             (preOpeningSelector isKindOf: Message) 
  430.                 ifTrue: [preOpeningSelector sendTo: model replacingParameter: 1 by: self]
  431.                 ifFalse: [model perform: preOpeningSelector with: self]].
  432.     self controller open! !
  433.  
  434. !ExtendedStandardSystemView methodsFor: 'post-closing'!
  435. release
  436.     postClosingSelector isNil ifFalse: [
  437.         (postClosingSelector isKindOf: Message) 
  438.             ifTrue: [postClosingSelector sendTo: model replacingParameter: 1 by: self]
  439.             ifFalse: [model perform: postClosingSelector with: self]].
  440.     super release! !
  441. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  442.  
  443. ExtendedStandardSystemView class
  444.     instanceVariableNames: ''!
  445.  
  446. !ExtendedStandardSystemView class methodsFor: 'private printing support'!
  447. storeBorderWidth: borderWidth messageOn: aStream
  448.     borderWidth = ((0@0 extent: 0@0) translateBy: borderWidth left)
  449.         ifTrue: [
  450.             aStream nextPutAll: 'borderWidth: '; store: borderWidth left]
  451.         ifFalse: [
  452.             aStream 
  453.                 nextPutAll: 'borderWidthLeft: '; store: borderWidth left;
  454.                 nextPutAll: ' right: '; store: borderWidth right;
  455.                 nextPutAll: ' top: '; store: borderWidth top;
  456.                 nextPutAll: ' bottom: '; store: borderWidth bottom]!
  457. storeEncoding: encoding on: aStream indent: indentation
  458.     "Store the windowMakerEncoding with indented line continuations (assuming lines of approximately 80 characters)."
  459.  
  460.     | return internalStream leaderSize size character start end |
  461.     return _ (WriteStream on: (String new: 16)) crtab: indentation; contents.
  462.     internalStream _ ReadWriteStream on: (String new: 10000).
  463.     internalStream nextPutAll: '"WindowMaker edit:" '; store: encoding; reset.
  464.     
  465.     leaderSize _ return asDisplayText width // ' ' asDisplayText width.
  466.     size _ leaderSize +  'encoding: ' size.
  467.     [internalStream atEnd] whileFalse: [
  468.         character _ internalStream next.
  469.         character = $' ifTrue: [
  470.             size > 80 ifTrue: [aStream nextPutAll: return. size _ leaderSize].
  471.             internalStream skip: -1. start _ aStream position.
  472.             [internalStream peek == $'] whileTrue: [
  473.                 aStream 
  474.                     nextPut: internalStream next; 
  475.                     nextPutAll: (internalStream upTo: $'); 
  476.                     nextPut: $'].
  477.             end _ aStream position. size _ size + (end - start)] ifFalse: [
  478.         character = $  ifTrue: [
  479.             internalStream peek == $) "eliminate space in ' )'"
  480.                 ifTrue: [aStream nextPut: internalStream next. size _ size + 1]
  481.                 ifFalse: [
  482.                     size > 80 
  483.                         ifTrue: [aStream nextPutAll: return. size _ leaderSize]
  484.                         ifFalse: [aStream nextPut: character. size _ size + 1]]] ifFalse: [
  485.         aStream nextPut: character. size _ size + 1]]]!
  486. storeInsideColor: insideColor on: aStream
  487.     insideColor isNil ifTrue: [^aStream nextPutAll: 'nil'].
  488.     #(black darkGray gray lightGray veryLightGray white) do: [:candidate |
  489.         (insideColor == (Form perform: candidate)) ifTrue: [^aStream nextPutAll: 'Form '; print: candidate]].
  490.     self error: 'unknown insideColor'! !
  491.  
  492. !ExtendedStandardSystemView class methodsFor: 'compiling support'!
  493. compile: view intoClass: class method: methodName category: categoryName
  494.     "Compile the receiver into the specified class."
  495.     ^self compile: view intoClass: class method: methodName category: categoryName overFlowCategory: categoryName, ' overflow'!
  496. compile: view intoClass: class method: methodName category: categoryName overFlowCategory: overflowCategoryName
  497.     "Compile the receiver into the specified class."
  498.     ^self compileOneOrMoreMethods: view intoClass: class method: methodName 
  499.         category: categoryName overFlowCategory: overflowCategoryName! !
  500.  
  501. !ExtendedStandardSystemView class methodsFor: 'private compiling support'!
  502. compileEncoding: view intoClass: class method: methodName category: categoryName
  503.     "Attempts to compile just the encoding as a method."
  504.  
  505.     Transcript show: ' method 1'.
  506.     (self tryCompilingContinuation: 0 view: view intoClass: class method: methodName category: categoryName overFlowCategory: nil lastPiece: -2 pieces: 1)
  507.         ifTrue: [
  508.             Transcript show: '+'.
  509.             self removeContinuationsStartingAt: 1 for: methodName class: class]
  510.         ifFalse: [
  511.             Transcript show: '-'.
  512.             ^self error: 'method too large -- cannot be compiled. Continue to give up']!
  513. compileOneOrMoreMethods: view intoClass: class method: methodName category: categoryName overFlowCategory: overflowCategoryName
  514.     "Attempts to compile one method in the specified class that re-creates the view. If it is too large to compile, breaks it up by creating additional overflow methods with suffixes 'Continue1:', 'Continue2:', ... that add the subviews. These overflow methods are placed in category overflowCategoryName."
  515.     | aStream source |
  516.  
  517.     "Create the method."
  518.     Transcript show: ' method 1'.
  519.     aStream _ WriteStream on: (String new: 10000).
  520.     aStream 
  521.         nextPutAll: methodName; crtab; 
  522.         nextPutAll: '"Returns an initialized view."'; crtab;
  523.         nextPut: $^; store: view.
  524.  
  525.     "Compile it."
  526.     source _ aStream contents. aStream _ nil.
  527.     (self tryCompiling: source class: class classified: categoryName)
  528.         ifTrue: [
  529.             Transcript show: '+'.
  530.             self removeContinuationsStartingAt: 1 for: methodName class: class]
  531.         ifFalse: [
  532.             Transcript show: '-'. source _ nil. 
  533.             ^self compileTwoOrMoreMethods: view intoClass: class
  534.                 method: methodName category: categoryName 
  535.                 overFlowCategory: overflowCategoryName]!
  536. compileTwoOrMoreMethods: view intoClass: class method: methodName category: categoryName overFlowCategory: overflowCategoryName
  537.     "Compile the view in pieces where the encoding is considered one piece (piece -1), the top view is considered another piece (piece 0), and the individual subviews are pieces (1, 2, 3, ...). Attempt to put at many pieces into each method as the compiler will permit. The first method with name methodName is place in category categoryName. The overflow methods have suffixes 'Continue1:', 'Continue2:', ... appended to the method name. They are placed in category overflowCategoryName."
  538.  
  539.     | lastPiece limit continuation mostPieces fewestPieces pieces next |
  540.     "Iterate to create the maximal sized compiled method."
  541.     Transcript nextPutAll: ' method 1 <'.
  542.     lastPiece _ -2. limit _ view subViews size. 
  543.     continuation _ 0. mostPieces _ nil. fewestPieces _ nil. pieces _ 0.
  544.     [lastPiece <= limit] whileTrue: [
  545.         next _ self whatToDoNextGiven: view and: lastPiece + pieces and: mostPieces and: fewestPieces.
  546.         next == #done ifTrue: [
  547.             Transcript nextPutAll: '>'.
  548.             self removeContinuationsStartingAt: continuation+1 for: methodName class: class.
  549.             ^self].
  550.         next == #doneEnough ifTrue: [
  551.             lastPiece _ lastPiece + mostPieces.
  552.             CompilationHeuristic _ mostPieces.
  553.             continuation _ continuation + 1.
  554.             Transcript nextPutAll: '>, '; print: continuation+1; nextPutAll: ' <'.
  555.             mostPieces _ nil. fewestPieces _ nil. pieces _ 0].
  556.         next == #tryAgain ifTrue: [
  557.             pieces _ self piecesToTryGiven: mostPieces and: fewestPieces.
  558.             pieces < 1 ifTrue: [
  559.                 Transcript show: '>-'.
  560.                 ^self error: 'method too large -- cannot be compiled. Continue to give up'].
  561.             Transcript show: pieces printString.
  562.             (self tryCompilingContinuation: continuation view: view intoClass: class
  563.                 method: methodName category: categoryName 
  564.                 overFlowCategory: overflowCategoryName
  565.                 lastPiece: lastPiece pieces: pieces)
  566.                 ifTrue: [Transcript show: '+'. mostPieces _ pieces]
  567.                 ifFalse: [Transcript show: '-'. fewestPieces _ pieces. pieces _ 0]]]!
  568. continuationName: index for: methodName
  569.     ^(methodName, 'Continue', index printString, ':') asSymbol!
  570. piecesToTryGiven: mostSuccessful and: leastUnsuccessful
  571.     mostSuccessful isNil & leastUnsuccessful isNil
  572.         ifTrue: [^CompilationHeuristic isNil ifTrue: [5] ifFalse: [CompilationHeuristic]]
  573.         ifFalse: [
  574.             mostSuccessful isNil
  575.                 ifTrue: [^leastUnsuccessful - 1]
  576.                 ifFalse: [^mostSuccessful + 1]].!
  577. removeContinuationsStartingAt: start for: methodName class: class
  578.     | index selector |
  579.     index _ start. selector _ self continuationName: index for: methodName.
  580.     [class includesSelector: selector] whileTrue: [
  581.         class removeSelector: selector.
  582.         index _ index + 1. 
  583.         selector _ self continuationName: index for: methodName]!
  584. tryCompiling: aMethodString class: class classified: aCategoryString
  585.     "Returns true if compilation is successful; false otherwise. Note: this method is invoked rather than executing the code inline to force compiler data structures to disappear (it only happens when a return from compile:classified:notifying: occurs or the error block is executed)."
  586.     | notifier |
  587.     notifier _ ErrorHandler new errorBlock: [:message :position | ^false].
  588.     class compile: aMethodString classified: aCategoryString notifying: notifier.
  589.     ^true!
  590. tryCompilingContinuation: continuationIndex view: view intoClass: class method: methodName category: categoryName overFlowCategory: overflowCategoryName lastPiece: lastPiece pieces: pieces
  591.     "Compiles a method with with name methodName (for continuationIndex 0) and suffixes 'Continue1:', 'Continue2:', .... for (continuationIndex > 0). Piece -1 is interpreted as the encoding, piece 0 is the top view, and pieces 1, 2, 3, ... are the subviews. No additional overflow methods are generated if overflowCategoryName is nil."
  592.     | views start end aStream source |
  593.  
  594.     "Determine the output range for the pieces."
  595.     views _ view subViews. start _ lastPiece + 1. end _ lastPiece + pieces min: views size.
  596.  
  597.     "Create the method."
  598.  
  599.     "First, the method header."
  600.     aStream _ WriteStream on: (String new: 10000).
  601.     start = -1 
  602.         ifTrue: [
  603.             aStream 
  604.                 nextPutAll: methodName; crtab;
  605.                 nextPutAll: '"Returns an initialized view."'; crtab;
  606.                 nextPutAll: (end > -1 ifTrue: ['| anArray aView |'] ifFalse: ['| anArray |']); cr;
  607.                 crtab] 
  608.         ifFalse: [
  609.             aStream 
  610.                 nextPutAll: (self continuationName: continuationIndex for: methodName); 
  611.                 nextPutAll: (start = 0 ifTrue: [' anArray'] ifFalse: [' aView']); crtab;
  612.                 nextPutAll: '"Continues initializing view."'; cr.
  613.             start = 0 ifTrue: [aStream tab; nextPutAll: '| aView |'; cr].
  614.             aStream crtab].
  615.             
  616.     "Second, the actual code."
  617.     start to: end do: [:index |
  618.         index = -1
  619.             ifTrue: [
  620.                 aStream nextPutAll: 'anArray _ '.
  621.                 ExtendedStandardSystemView storeEncoding: view encoding on: aStream 
  622.                     indent: 2]
  623.             ifFalse: [
  624.                 index = 0
  625.                     ifTrue: [
  626.                         aStream nextPutAll: 'aView _ '.
  627.                         view storeOn: aStream encoding: 'anArray' subViews: false indent: 2]
  628.                     ifFalse: [
  629.                         aStream nextPutAll: 'aView addSubView: '.
  630.                         (views at: index) storeOn: aStream indent: 2]].
  631.         aStream nextPut: $.; crtab].
  632.  
  633.     "Third, the end of the method."
  634.     end = views size
  635.         ifTrue: [aStream nextPutAll: '^aView']
  636.         ifFalse: [
  637.             overflowCategoryName isNil
  638.                 ifTrue: [
  639.                     aStream 
  640.                         nextPut: $^;
  641.                         nextPutAll: (end = -1 ifTrue: ['anArray'] ifFalse: ['aView'])]
  642.                 ifFalse: [
  643.                     aStream
  644.                         nextPutAll: '^self ';
  645.                         nextPutAll: (self continuationName: continuationIndex+1 for: methodName); 
  646.                         nextPutAll: (end = -1 ifTrue: [' anArray'] ifFalse: [' aView'])]].
  647.  
  648.     "Compile it."
  649.     source _ aStream contents. aStream _ nil.
  650.     ^self tryCompiling: source class: class classified: 
  651.         (continuationIndex = 0 ifTrue: [categoryName] ifFalse: [overflowCategoryName])!
  652. whatToDoNextGiven: view and: totalSoFar and: mostSuccessful and: leastUnsuccessful
  653.     totalSoFar >= view subViews size ifTrue: [^#done].
  654.     mostSuccessful isNil ifTrue: [^#tryAgain].
  655.     leastUnsuccessful isNil ifTrue: [^#tryAgain].
  656.     mostSuccessful + 1 = leastUnsuccessful
  657.         ifTrue: [^#doneEnough]
  658.         ifFalse: [^#tryAgain]! !
  659.  
  660. Smalltalk garbageCollect!
  661.  
  662. SwitchController subclass: #ExtendedSwitchController
  663.     instanceVariableNames: ''
  664.     classVariableNames: ''
  665.     poolDictionaries: ''
  666.     category: 'WindowMakerSupport'!
  667.  
  668. !ExtendedSwitchController methodsFor: 'model querying'!
  669. sendMessage
  670.     (selector isKindOf: Message) ifTrue: [^selector sendTo: model].
  671.     ^super sendMessage! !
  672.  
  673.  
  674. SwitchView subclass: #ExtendedSwitchView
  675.     instanceVariableNames: 'name labelSource labelSourceForm highlightSource aspect fixedPoint fixedPointCode mode highlightOverlay updateInProgress '
  676.     classVariableNames: ''
  677.     poolDictionaries: ''
  678.     category: 'WindowMakerSupport'!
  679. ExtendedSwitchView comment:
  680. 'Provides either a constant- (the default) or varying-sized view for displaying the switch labels. The first is meant for labels that don''t scale; the second for labels that do. The second also permits a switch label that doesn''t scale to be displayed in a varying-sized area. An example of an object that scales is a form; an example of one that doesn''t is a string converted to a paragraph or a display text. Constant-sized views have display boxes that are the same size as the window. There is no such correlation for varying-sized views.
  681.  
  682. To better explain the two varieties, suppose an extended switch view''s label size is 10-by-10. Also, the view''s window of size 50@50 would under normal circumstances transform to a display box of size 100@100. Let''s call this display box -- the expected display box. Three cases are possible:
  683.  
  684.     1. constant-size view => the actual display box ends up being 50-by-50. Where it is actually positioned will depends on a specified fixed point (discussed below).
  685.     2. varying-size view and a label that doesn''t scale => the actual display box is the expected display box of size 100@100 but the label (unscaled) can be positioned anywhere inside; again, this is specified via a fixed point.
  686.     3. varying-size view and a label that scales => the actual display box is the expected display box of size 100@100 and the label is scaled to fit exactly.
  687.  
  688. Fixed points are used to specify which part of the view''s window is to be transformed unaltered. When the fixed point is inside the window, self relative positioning is obtained. When it is outside, more global positioning permits rows or columns of views to be made adjacent. For example, methods fixTopLeftCorner, fixCenter, and fixBottomRightCorner cause the 50-by-50 window mentioned above to be positioned at the top left, center, and bottom right respectively of the expected display box (inside positioning). Methods fixInHorizontalBankAtPosition: and fixInVerticalBankAtPosition: cause the 50-by-50 window to be positioned in a row or column respectively (the row or column index is a parameter).
  689.  
  690. Users can also provide a highlight object and specify whether or not it is to be overlayed over the label as opposed to replacing it when the switch is depressed (the default is to replace). If no highlight object is provided, highlighting is perform in the standard way (using reverse video).
  691.  
  692. Additionally, the view permits an arbitrary change/update symbol called the aspect symbol to be specified. By contrast, switch views use the selector as the aspect symbol. 
  693.  
  694. Finally, both the view''s ''isOn'' selector and the controller''s ''switch'' selector can be blocks with two parameters: model, view.
  695.  
  696.  
  697. OLDER VERSION:
  698.  
  699. Provides either a constant- (the default) or varying-sized view for displaying the switch labels. The first is meant for labels that don''t scale; the second for labels that do. The second also permits a switch label that doesn''t scale to be displayed in a varying-sized area. An example of an object that scales is a form; an example of one that doesn''t is a string converted to a paragraph or a display text.
  700.  
  701. To better explain the two varieties, suppose an extended switch view''s label size is 10-by-10 but the view''s window would under normal circumstances transform to a display box of size 50@50. Let''s call this display box -- the expected display box. Three cases are possible:
  702.  
  703.     1. constant-size view => the actual display box ends up being 10-by-10 plus the border size. Where it actually ends up will depends on a specified fixed point (discussed below).
  704.     2. varying-size view and a label that doesn''t scale => the actual display box is the expected display box of size 50@50 but the label (unscaled) can be positioned anywhere inside; again, this is specified via a fixed point.
  705.     3. varying-size view and a label that scales => the actual display box is the expected display box of size 50@50 and the label is scaled to fit exactly.
  706.  
  707. Fixed points are used to specify which part of the view''s window is to be transformed unaltered. When the fixed point is inside the window, self relative positioning is obtained. When it is outside, more global positioning permits rows or columns of views to be made adjacent. For example, methods fixTopLeftCorner, fixCenter, and fixBottomRightCorner cause the 10-by-10 label mentioned above to be positioned at the top left, center, and bottom right respectively of the expected display box (inside positioning). Methods fixInHorizontalBankAtPosition: and fixInVerticalBankAtPosition: cause the 10-by-10 label to be positioned in a row or column respectively (the row or column index is a parameter).
  708.  
  709. Users can also provide a highlight object and specify whether or not it is to be overlayed over the label as opposed to replacing it when the switch is depressed (the default is to replace). If no highlight object is provided, highlighting is perform in the standard way (using reverse video).
  710.  
  711. Additionally, the view permits an arbitrary change/update symbol called the aspect symbol to be specified. By contrast, switch views use the selector as the aspect symbol. 
  712.  
  713. Finally, both the view''s ''isOn'' selector and the controller''s ''switch'' selector can be blocks with two parameters: model, view.'!
  714.  
  715. !ExtendedSwitchView methodsFor: 'instance initialization'!
  716. defaultWindow
  717.     "If the label exists, returns a rectangle large enough (but not much more) to contain the label and its border. Otherwise, returns a small rectangle."
  718.     label == nil
  719.         ifTrue: [^0@0 corner: 25@25]
  720.         ifFalse: [^(label boundingBox expandBy: borderWidth) expandBy: 5]!
  721. initialize
  722.     super initialize.
  723.     "aspect, fixedPoint, updateInProgress are nil"
  724.     fixedPointCode _ #center.
  725.     mode _ #constant.
  726.     highlightOverlay _ false.
  727.     "Until user initialized, ensure the selector test returns false."
  728.     self selector: #==; arguments: (Array with: Object new)! !
  729.  
  730. !ExtendedSwitchView methodsFor: 'name'!
  731. name
  732.     ^name!
  733. name: aSymbolOrNil
  734.     name _ aSymbolOrNil!
  735. viewNamed: aSymbol
  736.     name == aSymbol ifTrue: [^self] ifFalse: [^nil]! !
  737.  
  738. !ExtendedSwitchView methodsFor: 'model'!
  739. models: anObject
  740.     "If this view's model is nil, changes it to anObject; otherwise, does nothing."
  741.     model isNil ifFalse: [^self].
  742.     self model: anObject!
  743. resetModels
  744.     "Sets this view's model to nil."
  745.     self model: nil! !
  746.  
  747. !ExtendedSwitchView methodsFor: 'mode and highlighting'!
  748. mode
  749.     ^mode!
  750. mode: aSymbol
  751.     "Checks for erroneous settings."
  752.     (#(constant varying) indexOf: aSymbol) = 0
  753.         ifTrue: [self error: 'allowable modes are #constant or #varying'].
  754.     mode _ aSymbol. self unlock!
  755. overlayHighlight
  756.     ^highlightOverlay!
  757. overlayHighlight: aBoolean
  758.     highlightOverlay _ aBoolean! !
  759.  
  760. !ExtendedSwitchView methodsFor: 'fixed point querying'!
  761. fixedPoint
  762.     | aPoint xIndex yIndex topWindowOrigin oldWindow |
  763.     fixedPoint isNil ifTrue: [
  764.         fixedPointCode isNil 
  765.             ifTrue: [^fixedPoint _ self getWindow center].
  766.         (fixedPointCode isKindOf: Symbol) 
  767.             ifTrue: [^fixedPoint _ self getWindow perform: fixedPointCode].
  768.         (fixedPointCode isKindOf: Point) 
  769.             ifTrue: [^fixedPoint _ fixedPointCode]
  770.             ifFalse: ["must be a row, column, or matrix"
  771.                 "Assumes all switches are the same size"
  772.                 "The vertical bank is numbered 1, 2, 3, ... from the top."
  773.                 "The horizontal bank is numbered 1, 2, 3, .... from the left"
  774.                 aPoint _ fixedPointCode at: 1. xIndex _ aPoint x. yIndex _ aPoint y.
  775.                 oldWindow _ self getWindow.
  776.                 topWindowOrigin _ oldWindow origin - 
  777.                     (((xIndex-1) * oldWindow width)@((yIndex-1) * oldWindow height)).
  778.                 ^fixedPoint _ topWindowOrigin]].
  779.     ^fixedPoint!
  780. fixedPointEncoding
  781.     fixedPoint isNil ifTrue: ["force the code to be computed" self fixedPoint].
  782.     fixedPointCode isNil ifTrue: [^#fixCenter].
  783.     (fixedPointCode isKindOf: Symbol) ifTrue: [
  784.         ^#(fixBottomLeft fixBottomRight fixCenter fixMiddleLeft 
  785.             fixMiddleRight fixTopLeft fixTopRight) 
  786.                 at: (#(bottomLeft corner center leftCenter 
  787.                     rightCenter origin topRight) indexOf: fixedPointCode)].
  788.     (fixedPointCode isKindOf: Point) 
  789.         ifTrue: [^'fixPoint: ', fixedPointCode printString]
  790.         ifFalse: [^'fixMatrix: ', (fixedPointCode at: 1) printString]! !
  791.  
  792. !ExtendedSwitchView methodsFor: 'fixed point manipulation'!
  793. fixBottomLeft
  794.     fixedPointCode _ #bottomLeft. self unlock!
  795. fixBottomRight
  796.     fixedPointCode _ #corner. self unlock!
  797. fixCenter
  798.     fixedPointCode _ #center. self unlock!
  799. fixColumn: anInteger
  800.     "Assumes all switches in the column are the same size and numbered 1, 2, 3, ... from the top."
  801.     fixedPointCode _ Array with: 0@anInteger. self unlock!
  802. fixMatrix: aPoint
  803.     "Assumes all switches are the same size with x rows and y columns."
  804.     "The rows are numbered 1, 2, 3, ... from the top."
  805.     "The columns are numbered 1, 2, 3, .... from the left"
  806.     fixedPointCode _ Array with: aPoint. self unlock!
  807. fixMiddleLeft
  808.     fixedPointCode _ #leftCenter. self unlock!
  809. fixMiddleRight
  810.     fixedPointCode _ #rightCenter. self unlock!
  811. fixPoint: aPoint
  812.     fixedPointCode _ aPoint. self unlock!
  813. fixRow: anInteger
  814.     "Assumes all switches in the row are the same size and numbered 1, 2, 3, .... from the left."
  815.     fixedPointCode _ Array with: anInteger@0. self unlock!
  816. fixTopLeft
  817.     fixedPointCode _ #origin. self unlock!
  818. fixTopRight
  819.     fixedPointCode _ #topRight. self unlock! !
  820.  
  821. !ExtendedSwitchView methodsFor: 'label/highlight modification'!
  822. centerLabel
  823.     "Deactivated because too many inherited methods attempt to center the label by destructively modifying it."!
  824. highlight: aDisplayObjectOrSymbolOrNil
  825.     highlightSource _ aDisplayObjectOrSymbolOrNil. 
  826.     highlightSource == #fromLabel
  827.         ifTrue: [
  828.             (labelSourceForm respondsTo: #highlight)
  829.                 ifTrue: [super highlightForm: labelSourceForm highlight]
  830.                 ifFalse: [super highlightForm: nil]]
  831.         ifFalse: [super highlightForm: highlightSource]!
  832. label: displayObjectOrLibraryPathName
  833.     (displayObjectOrLibraryPathName isKindOf: Array)
  834.         ifTrue: [
  835.             labelSource _ displayObjectOrLibraryPathName.
  836.             labelSourceForm _ FormLibrarian formForPathName: labelSource.
  837.             super label: labelSourceForm]
  838.         ifFalse: [
  839.             labelSource _ labelSourceForm _ nil.
  840.             super label: displayObjectOrLibraryPathName]! !
  841.  
  842. !ExtendedSwitchView methodsFor: 'controller access'!
  843. defaultControllerClass 
  844.     ^ExtendedSwitchController! !
  845.  
  846. !ExtendedSwitchView methodsFor: 'emphasizing'!
  847. deEmphasizeView 
  848.     "Deactivated. See View|deEmphasizeView."
  849.     ^self!
  850. emphasizeView 
  851.     "Deactivated. See View|deEmphasizeView."
  852.     ^self! !
  853.  
  854. !ExtendedSwitchView methodsFor: 'adaptor'!
  855. interrogateModel
  856.     (selector isKindOf: Message) ifTrue: [^selector sendTo: model].
  857.     ^super interrogateModel! !
  858.  
  859. !ExtendedSwitchView methodsFor: 'copying'!
  860. deepCopy
  861.     ^self shallowCopy
  862.         superView: nil; resetSubViews;
  863.         model: model deepCopy controller: nil;
  864.         transformation: transformation "stores a copy";
  865.         window: window "stores a copy";
  866.         yourself! !
  867.  
  868. !ExtendedSwitchView methodsFor: 'displaying'!
  869. computeDisplayTransformation
  870.     "For varying-size switches, the default computeDisplayTransformation is used. For constant-size switches, additional computation is required. First, the default display transformation is computed and then used to determine where the fixed point should be displayed. Then a new display transformation with no scaling is constructed which translates the label origin in such a way that the fixed point is at the position determined above. Note that the resulting display box is consequently the same size as the window (not necessarily the same size as the label)."
  871.  
  872.     | scaledTransformation sourceFixedPoint destinationFixedPoint |
  873.     fixedPoint _ nil. 
  874.     scaledTransformation _ self superComputeDisplayTransformation.
  875.     mode == #constant ifFalse: [^scaledTransformation].
  876.  
  877.     sourceFixedPoint _ self fixedPoint.
  878.     destinationFixedPoint _ scaledTransformation applyTo: sourceFixedPoint.
  879.     ^WindowingTransformation scale: nil translation: destinationFixedPoint - sourceFixedPoint!
  880. display
  881.     "Displays the view taking into account the status of the model, the label, and the highlight object. To present an instantaneous picture, the view is first internally displayed on a form."
  882.  
  883.     | aForm displayBox |
  884.     "Take the inside color into account when obtaining the form."
  885.     aForm _ insideColor isNil 
  886.         ifTrue: [Form fromDisplay: (displayBox _ self displayBox)]
  887.         ifFalse: [Form extent: (displayBox _ self displayBox) extent].
  888.     self displayOn: aForm at: 0@0 clippingBox: aForm boundingBox rule: Form under mask: Form black.
  889.     "Display the form."
  890.     aForm displayOn: Display at: displayBox origin!
  891. displayOn: aForm at: aPoint clippingBox: aRectangle rule: ruleInteger mask: maskForm
  892.     "Displays the view taking into account the status of the model, the label, and the highlight object."
  893.  
  894.     | outside displayBox inside newTransformation |
  895.     outside _ aPoint extent: (displayBox _ self displayBox) extent.
  896.     inside _ outside insetBy: borderWidth.
  897.     newTransformation _ self transformationToDisplayIn: inside.
  898.  
  899.     complemented _ self interrogateModel. "update the view's status"
  900.  
  901.     "The border."
  902.     (outside areasOutside: inside) do: [:area |
  903.         aForm fill: (area intersect: aRectangle) rule: ruleInteger mask: borderColor].
  904.     outside _ outside intersect: aRectangle.
  905.     inside _ inside intersect: aRectangle.
  906.  
  907.     "The inside."
  908.     insideColor isNil 
  909.         ifFalse: [aForm fill: inside rule: ruleInteger mask: insideColor].
  910.  
  911.     "The label."
  912.     label notNil & (complemented & highlightForm notNil & highlightOverlay) not
  913.         ifTrue: [
  914.             "Avoid displaying label if highlight is to be overlayed (can't erase label with rule under)."
  915.             label displayOn: aForm transformation: newTransformation clippingBox: inside 
  916.                 rule: ruleInteger mask: maskForm].
  917.  
  918.     "The highlight."
  919.     complemented ifTrue: [
  920.         highlightForm isNil
  921.             ifTrue: [aForm reverse: inside]
  922.             ifFalse: [
  923.                 highlightForm            
  924.                     displayOn: aForm transformation: newTransformation clippingBox: inside
  925.                     rule: (highlightOverlay ifTrue: [Form under] ifFalse: [ruleInteger])
  926.                     mask: maskForm]]!
  927. indicatorReverse
  928.     "Show that the switch has been pressed."
  929.     | inside outside newTransformation |
  930.  
  931.     inside _ self insetDisplayBox.
  932.     highlightForm isNil
  933.         ifTrue: [
  934.             Display reverse: inside mask: Form gray]
  935.         ifFalse: [
  936.             newTransformation _ self transformationToDisplayIn: inside.
  937.             (self interrogateModel ifTrue: [label] ifFalse: [highlightForm])
  938.                 displayOn: Display transformation: newTransformation clippingBox: inside
  939.                     rule: Form reverse mask: Form gray]!
  940. insetDisplayTransformation
  941.     "Ignores the borders."
  942.     ^WindowingTransformation
  943.         window: self insetWindow
  944.         viewport: self insetDisplayBox!
  945. superComputeDisplayTransformation
  946.     "Since the borders in the containing view do not actually scale, this view (if left unchanged) will be positioned at a point that assumes the borders did scale. This can be eliminated by transforming into the inset display box rather than the display box. See View | computeDisplayTransformation for the difference."
  947.  
  948.     self isTopView
  949.         ifTrue: [^transformation]
  950.         ifFalse: [^superView insetDisplayTransformation compose: transformation]!
  951. transformationToDisplayIn: aRectangle
  952.     "The given display transformation is designed to transform the window (which may be located anywhere) to the display box. Returns the transformation needed to transform the label into the center of the same display box."
  953.     | center |
  954.     (mode == #varying and: [(label isKindOf: Path) | (label isKindOf: Form)])
  955.         ifTrue: ["Object can resize - begs for canResize method."
  956.             "Start displaying at inside origin rather than outside origin."
  957.             ^WindowingTransformation window: label boundingBox viewport: aRectangle]
  958.         ifFalse: ["Object should not resize - center in inset display box."
  959.             center _ (label isNil ifTrue: [aRectangle] ifFalse: [label boundingBox]) center.
  960.             ^WindowingTransformation scale: nil translation: aRectangle center - center].! !
  961.  
  962. !ExtendedSwitchView methodsFor: 'updating'!
  963. aspect: aSymbol
  964.     aspect _ aSymbol!
  965. update: aSymbol
  966.     "Upward compatible with switch views; i.e. missing aspect results in using the selector instead."
  967.     | actualAspect |
  968.     updateInProgress isNil ifFalse: [^self].
  969.     actualAspect _ aspect isNil 
  970.         ifTrue: [(selector isKindOf: Message) ifTrue: [selector selector] ifFalse: [selector]]
  971.         ifFalse: [aspect].
  972.     actualAspect == aSymbol
  973.         ifTrue: [updateInProgress _ true. self display. updateInProgress _ nil]! !
  974.  
  975. !ExtendedSwitchView methodsFor: 'printing'!
  976. storeDisplayObject: anObject on: aStream
  977.     "Attempt to store the most compact representation possible."
  978.     (anObject isKindOf: DisplayText) 
  979.         ifTrue: [aStream store: anObject string; nextPutAll: ' asParagraph']
  980.         ifFalse: [anObject storeOn: aStream]!
  981. storeHighlightOn: aStream
  982.     "Attempt to store the most compact representation possible."
  983.     self storeDisplayObject: highlightSource on: aStream!
  984. storeLabelOn: aStream
  985.     "Attempt to store the most compact representation possible."
  986.     labelSource isNil
  987.         ifTrue: [^self storeDisplayObject: label on: aStream]
  988.         ifFalse: [^aStream store: labelSource]!
  989. storeOn: aStream
  990.     self storeOn: aStream indent: 2!
  991. storeOn: aStream indent: indentation
  992.     "Store this instance of an ExtendedSwitchView with indentation for readability."
  993.     | return continue |
  994.     return _ (WriteStream on: (String new: 16)) crtab: indentation; contents.
  995.     continue _ ';', return.
  996.     aStream
  997.         nextPutAll: '(('; nextPutAll: self class name; nextPutAll: ' on: nil'; nextPutAll: return;
  998.         nextPutAll: 'aspect: '; store: aspect; nextPutAll: return;
  999.         nextPutAll: 'label: '. self storeLabelOn: aStream. aStream nextPutAll: return;
  1000.         nextPutAll: 'isOnSelector: '; store: selector; 
  1001.             nextPutAll: ' isOnParameters: '; store: arguments; nextPutAll: return;
  1002.         nextPutAll: 'switchSelector: '; store: self controller selector; 
  1003.             nextPutAll: ' switchParameters: '; store: self controller arguments; 
  1004.             nextPut: $); nextPutAll: return;
  1005.         nextPutAll: 'name: '; store: name; nextPutAll: continue;
  1006.         nextPutAll: 'insideColor: '. ExtendedStandardSystemView storeInsideColor: insideColor on: aStream.
  1007.             aStream nextPutAll: continue.
  1008.         ExtendedStandardSystemView storeBorderWidth: borderWidth messageOn: aStream.
  1009.             aStream nextPutAll: continue;
  1010.         nextPutAll: 'window: '; store: window; nextPutAll: continue;
  1011.         nextPutAll: 'transformation: ('; print: transformation; nextPut: $); nextPutAll: continue;
  1012.         nextPutAll: 'highlight: '. self storeHighlightOn: aStream. aStream nextPutAll: continue;
  1013.         nextPutAll: 'mode: '; store: self mode; nextPutAll: continue;
  1014.         nextPutAll: self fixedPointEncoding; nextPutAll: continue;
  1015.         nextPutAll: 'yourself)'! !
  1016. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1017.  
  1018. ExtendedSwitchView class
  1019.     instanceVariableNames: ''!
  1020.  
  1021. !ExtendedSwitchView class methodsFor: 'instance creation'!
  1022. on: anObject aspect: aSymbol label: aDisplayObject isOn: isOnMessage switch: switchMessage
  1023.     "Both the isOn and switch messages may be Message instances."
  1024.     ^((self new 
  1025.         model: anObject; aspect: aSymbol; label: aDisplayObject; 
  1026.         selector: isOnMessage; arguments: #(); 
  1027.         mode: #constant; fixCenter) controller 
  1028.             selector: switchMessage; arguments: #()) view!
  1029. on: anObject aspect: aSymbol label: aDisplayObject isOnSelector: isOnSelector isOnParameters: isOnParms switchSelector: switchSelector switchParameters: switchParms
  1030.     ^((self new 
  1031.         model: anObject; aspect: aSymbol; label: aDisplayObject; 
  1032.         selector: isOnSelector; arguments: isOnParms; 
  1033.         mode: #constant; fixCenter) controller 
  1034.             selector: switchSelector; arguments: switchParms) view! !
  1035.  
  1036. !ExtendedSwitchView class methodsFor: 'private printing support'!
  1037. storeHighlight: highlight givenLabel: label on: aStream
  1038.     "Attempt to store the most compact representation possible."
  1039.     | path |
  1040.     (label isKindOf: FormWithHighlight) ifTrue: [
  1041.         (path _ FormLibrarian pathNameForForm: label) isNil ifFalse: [
  1042.             (FormLibrarian formForPathName: path) highlight == highlight ifTrue: [
  1043.                 ^aStream 
  1044.                     nextPutAll: '(FormLibrarian formForPathName: '; 
  1045.                     store: path; nextPutAll: ') highlight']]].
  1046.     ^self storeLabel: highlight on: aStream!
  1047. storeLabel: label on: aStream
  1048.     "Attempt to store the most compact representation possible."
  1049.     | path |
  1050.     label isNil ifTrue: [^aStream nextPutAll: 'nil'].
  1051.     (label isKindOf: Paragraph) ifTrue: [^aStream store: label asString; nextPutAll: ' asParagraph'].
  1052.     (label isKindOf: Form) ifTrue: [
  1053.         path _ FormLibrarian pathNameForForm: label.
  1054.         path isNil ifFalse: [
  1055.             ^aStream 
  1056.                 nextPutAll: '(FormLibrarian formForPathName: '; 
  1057.                 store: path; nextPut: $)]].
  1058.     label storeOn: aStream! !
  1059.  
  1060. !ExtendedSwitchView class methodsFor: 'examples'!
  1061. example1
  1062.     "ExtendedSwitchView example1"
  1063.  
  1064.     | topView labels switches switchCount switchHeight switchOffsets banks |
  1065.  
  1066.     topView _ StandardSystemView new 
  1067.         label: 'Unscaled Versus Scaled Switches'; insideColor: Form white; borderWidth: 2.
  1068.     labels _ #(normal read write execute crossHair) collect: [:aSymbol | Cursor perform: aSymbol].
  1069.     switches _ labels collect: [:aLabel | Switch newOff]. switchCount _ switches size.
  1070.     switchHeight _ (1/switchCount) asFloat. switchOffsets _ 0.0 to: 1.0 by: switchHeight. 
  1071.     switchOffsets _ switchOffsets copyFrom: 1 to: switchOffsets size - 1. "remove last entry"
  1072.  
  1073.     "Create 5 vertical banks of switches: the first four constant-size, the last varying-size. Use the same switches and labels to create five columns differing only in position and scaling."
  1074.     banks _ (1 to: 5) collect: [:bankIndex |
  1075.         (1 to: switchCount) collect: [:aSwitchIndex |
  1076.             ExtendedSwitchView new
  1077.                 model: (switches at: aSwitchIndex);
  1078.                 label: (labels at: aSwitchIndex);
  1079.                 mode: (bankIndex < 5 ifTrue: [#constant] ifFalse: [#varying])]].
  1080.  
  1081.     topView window: Display boundingBox. "helps eliminate transformation roundoff errors"
  1082.     banks with: #(0.0 0.2 0.4 0.6 0.8) do: [:aBank :anXOffset |
  1083.         aBank with: switchOffsets do: [:aSwitchView :aYOffset |
  1084.             topView addSubView: aSwitchView in: (anXOffset@aYOffset extent: 0.2@switchHeight) borderWidth: 1]].
  1085.  
  1086.     "Now specify the fixed point for the first four banks."
  1087.     (banks at: 1) do: [:aSwitchView | aSwitchView fixTopLeft].
  1088.     (banks at: 2) do: [:aSwitchView | aSwitchView fixCenter].
  1089.     (banks at: 3) do: [:aSwitchView | aSwitchView fixBottomRight].
  1090.     (banks at: 4) with: (1 to: switchCount) do: [:aSwitchView :aCount | 
  1091.         aSwitchView fixColumn: aCount].
  1092.  
  1093.     "Add some additional transparent subviews just to provide the grid so we can better see what happened. Note: this will have to be removed since it prevents the switch views from getting control."
  1094.     0.0 to: 0.8 by: 0.2 do: [:anXOffset |
  1095.         switchOffsets do: [:aYOffset |
  1096.             topView addSubView: View new in: (anXOffset@aYOffset extent: 0.2@switchHeight) borderWidth: 1]].
  1097.  
  1098.     topView controller open!
  1099. example2
  1100.     "ExtendedSwitchView example2"
  1101.  
  1102.     | topView labels switches switchCount switchHeight switchOffsets banks |
  1103.  
  1104.     topView _ StandardSystemView new
  1105.         label: 'Unscaled Versus Scaled Switches'; insideColor: Form white; borderWidth: 2.
  1106.     labels _ #(normal read execute) collect: [:aSymbol | Cursor perform: aSymbol].
  1107.     switches _ labels collect: [:aLabel | Switch newOff]. switchCount _ switches size.
  1108.     switchHeight _ (1/switchCount) asFloat. switchOffsets _ 0.0 to: 1.0 by: switchHeight. 
  1109.     switchOffsets _ switchOffsets copyFrom: 1 to: switchOffsets size - 1. "remove last entry"
  1110.  
  1111.     "Create 5 vertical banks of switches: the first four unscaled, the last scaled. Use the same switches and labels to create five columns differing only in position and scaling."
  1112.     banks _ (1 to: 5) collect: [:bankIndex |
  1113.         (1 to: switchCount) collect: [:aSwitchIndex |
  1114.             ExtendedSwitchView new
  1115.                 model: (switches at: aSwitchIndex);
  1116.                 label: (labels at: aSwitchIndex);
  1117.                 mode: (bankIndex < 5 ifTrue: [#constant] ifFalse: [#varying])]].
  1118.  
  1119.     topView window: Display boundingBox. "helps eliminate transformation roundoff errors"
  1120.     banks with: #(0.0 0.2 0.4 0.6 0.8) do: [:aBank :anXOffset |
  1121.         aBank with: switchOffsets do: [:aSwitchView :aYOffset |
  1122.             topView addSubView: aSwitchView in: (anXOffset@aYOffset extent: 0.2@switchHeight) borderWidth: 1]].
  1123.  
  1124.     "Now specify the fixed point for the first four banks."
  1125.     (banks at: 1) do: [:aSwitchView | aSwitchView fixTopLeft].
  1126.     (banks at: 2) do: [:aSwitchView | aSwitchView fixCenter].
  1127.     (banks at: 3) do: [:aSwitchView | aSwitchView fixBottomRight].
  1128.     (banks at: 4) with: (1 to: switchCount) do: [:aSwitchView :aCount | 
  1129.         aSwitchView fixColumn: aCount].
  1130.  
  1131.     "Add some unnecessary transparent subviews just to provide the grid so we can better see what happened."
  1132.     0.0 to: 0.8 by: 0.2 do: [:anXOffset |
  1133.         switchOffsets do: [:aYOffset |
  1134.             topView addSubView: View new in: (anXOffset@aYOffset extent: 0.2@switchHeight) borderWidth: 1]].
  1135.  
  1136.     "Turn on the 2nd switch."
  1137.     (switches at: 2) turnOn. "Note: causes spurious switches to be displayed since the top controller is not yet opened."
  1138.  
  1139.     topView controller open!
  1140. example3
  1141.     "Mixes forms and paragraphs. Since they are no longer identical in size, some differences will be apparent. Also, note that the fixed points have no effect in varying mode."
  1142.     "ExtendedSwitchView example3"
  1143.  
  1144.     | topView labels switches switchCount switchHeight switchOffsets banks switchWidth |
  1145.  
  1146.     topView _ StandardSystemView new 
  1147.         label: 'Unscaled/Unscaled Switches (Forms and Paragraphs)'; 
  1148.         insideColor: Form white; borderWidth: 2.
  1149.     labels _ 
  1150.         (#(normal read execute) collect: [:aSymbol | Cursor perform: aSymbol]),
  1151.         (#('aa' 'bb' 'cc') collect: [:aString | aString asParagraph]).
  1152.     switches _ labels collect: [:aLabel | Switch newOff]. switchCount _ switches size.
  1153.     switchHeight _ (1/switchCount) asFloat. 
  1154.     switchOffsets _ 0.0 to: 1.0-(switchHeight/10.0) by: switchHeight.
  1155.  
  1156.     "Create 8 vertical banks of switches: the first four unscaled, the last four scaled. Use the same switches and labels to create eight columns differing only in position and scaling."
  1157.     switchWidth _ (1/8) asFloat.
  1158.     banks _ (1 to: 8) collect: [:bankIndex |
  1159.         (1 to: switchCount) collect: [:aSwitchIndex |
  1160.             ExtendedSwitchView new
  1161.                 model: (switches at: aSwitchIndex);
  1162.                 label: (labels at: aSwitchIndex);
  1163.                 mode: (bankIndex < 5 ifTrue: [#constant] ifFalse: [#varying])]].
  1164.  
  1165.     topView window: Display boundingBox. "helps eliminate transformation roundoff errors"
  1166.     banks with: (0.0 to: 1.0-switchWidth by: switchWidth) do: [:aBank :anXOffset |
  1167.         aBank with: switchOffsets do: [:aSwitchView :aYOffset |
  1168.             topView 
  1169.                 addSubView: aSwitchView 
  1170.                 in: (anXOffset@aYOffset extent: switchWidth@switchHeight)
  1171.                 borderWidth: 1]].
  1172.  
  1173.     "Now specify the fixed point for the first four banks."
  1174.     (banks at: 1) do: [:aSwitchView | aSwitchView fixTopLeft].
  1175.     (banks at: 2) do: [:aSwitchView | aSwitchView fixCenter].
  1176.     (banks at: 3) do: [:aSwitchView | aSwitchView fixBottomRight].
  1177.     (banks at: 4) with: (1 to: switchCount) do: [:aSwitchView :aCount | 
  1178.         aSwitchView fixColumn: aCount].
  1179.  
  1180.     "Ditto for the next four banks."
  1181.     (banks at: 5) do: [:aSwitchView | aSwitchView fixTopLeft].
  1182.     (banks at: 6) do: [:aSwitchView | aSwitchView fixCenter].
  1183.     (banks at: 7) do: [:aSwitchView | aSwitchView fixBottomRight].
  1184.     (banks at: 8) with: (1 to: switchCount) do: [:aSwitchView :aCount | 
  1185.         aSwitchView fixColumn: aCount].
  1186.  
  1187.     "Add some unnecessary transparent subviews just to provide the grid so we can better see what happened."
  1188.     (0.0 to: 1.0-switchWidth by: switchWidth) do: [:anXOffset |
  1189.         switchOffsets do: [:aYOffset |
  1190.             topView 
  1191.                 addSubView: View new 
  1192.                 in: (anXOffset@aYOffset extent: switchWidth@switchHeight) 
  1193.                 borderWidth: 1]].
  1194.  
  1195.     "Turn on the 2nd switch."
  1196.     (switches at: 2) turnOn. "Note: causes spurious switches to be displayed since the top controller is not yet opened."
  1197.  
  1198.     topView controller open!
  1199. example4
  1200.     "Illustrates that scaling of 0.9@0.9 also works. Note that if a view is scaled, adjacent views to the right must shift left."
  1201.     "ExtendedSwitchView example4"
  1202.  
  1203.     | topView labels switches switchCount switchHeight switchOffsets banks switchWidth |
  1204.  
  1205.     topView _ StandardSystemView new 
  1206.         label: 'View Re-scaling Experiment'; insideColor: Form white; borderWidth: 2.
  1207.     labels _ 
  1208.         (#(normal read write) collect: [:aSymbol | Cursor perform: aSymbol]),
  1209.         (#('aa' 'bb') collect: [:aString | aString asParagraph]).
  1210.     switches _ labels collect: [:aLabel | Switch newOff]. switchCount _ switches size.
  1211.     switchHeight _ (1/switchCount) asFloat. 
  1212.     switchOffsets _ 0.0 to: 1.0-switchHeight by: switchHeight.
  1213.  
  1214.     "Create 8 vertical views of the same switches: the first four unscaled (constant), the last four scaled (varying)."
  1215.     switchWidth _ (1/8) asFloat.
  1216.     banks _ (1 to: 8) collect: [:bankIndex |
  1217.         (1 to: switchCount) collect: [:aSwitchIndex |
  1218.             ExtendedSwitchView new
  1219.                 model: (switches at: aSwitchIndex);
  1220.                 label: (labels at: aSwitchIndex);
  1221.                 mode: (bankIndex < 5 ifTrue: [#constant] ifFalse: [#varying])]].
  1222.  
  1223.     topView window: Display boundingBox. "helps eliminate transformation roundoff errors"
  1224.     banks with: (0.0 to: 1.0-switchWidth by: switchWidth) do: [:aBank :anXOffset |
  1225.         aBank with: switchOffsets do: [:aSwitchView :aYOffset |
  1226.             topView 
  1227.                 addSubView: aSwitchView 
  1228.                 in: (anXOffset@aYOffset extent: switchWidth@switchHeight)
  1229.                 borderWidth: 1]].
  1230.  
  1231.     "Now specify the fixed points."
  1232.     1 to: 8-1 by: 4 do: [:group |
  1233.         (banks at: group) do: [:aSwitchView | aSwitchView fixTopLeft; scaleBy: 0.9@0.9].
  1234.         (banks at: group+1) do: [:aSwitchView | aSwitchView fixCenter; scaleBy: 0.9@0.9].
  1235.         (banks at: group+2) do: [:aSwitchView | aSwitchView fixBottomRight; scaleBy: 0.9@0.9].
  1236.         (banks at: group+3) with: (1 to: switchCount) do: [:aSwitchView :aCount | 
  1237.             aSwitchView fixColumn: aCount; scaleBy: 0.9@0.9]].
  1238.  
  1239.     "Add some unnecessary transparent subviews just to provide the grid so we can better see what happened."
  1240.     (0.0 to: 1.0-switchWidth by: switchWidth) do: [:anXOffset |
  1241.         switchOffsets do: [:aYOffset |
  1242.             topView 
  1243.                 addSubView: View new 
  1244.                 in: (anXOffset@aYOffset extent: switchWidth@switchHeight) 
  1245.                 borderWidth: 1]].
  1246.  
  1247.     "Turn on some switches."
  1248.     (switches at: 2) turnOn. (switches at: 4) turnOn.
  1249.  
  1250.     topView controller open! !
  1251.  
  1252.  
  1253. ExtendedSwitchView subclass: #ExtendedPictureView
  1254.     instanceVariableNames: 'labelMessage '
  1255.     classVariableNames: ''
  1256.     poolDictionaries: ''
  1257.     category: 'WindowMakerSupport'!
  1258.  
  1259. !ExtendedPictureView methodsFor: 'controller access'!
  1260. defaultControllerClass 
  1261.     ^NoController! !
  1262.  
  1263. !ExtendedPictureView methodsFor: 'updating'!
  1264. labelMessage
  1265.     ^labelMessage!
  1266. labelMessage: aSymbolOrNil
  1267.     labelMessage _ aSymbolOrNil!
  1268. update: aSymbol
  1269.     aspect == aSymbol ifTrue: [self display]! !
  1270.  
  1271. !ExtendedPictureView methodsFor: 'displaying'!
  1272. display
  1273.     labelMessage isNil ifFalse: [
  1274.         self label: ((labelMessage isKindOf: Message) 
  1275.             ifTrue: [labelMessage sendTo: model]
  1276.             ifFalse: [model perform: labelMessage])].
  1277.     super display! !
  1278.  
  1279. !ExtendedPictureView methodsFor: 'printing'!
  1280. storeOn: aStream indent: indentation
  1281.     "Store this instance of an ExtendedPictureView with indentation for readability."
  1282.     | return continue |
  1283.     return _ (WriteStream on: (String new: 16)) crtab: indentation; contents.
  1284.     continue _ ';', return.
  1285.     aStream
  1286.         nextPutAll: '((ExtendedPictureView on: nil'; nextPutAll: return;
  1287.         nextPutAll: 'aspect: '; store: aspect; nextPutAll: return;
  1288.         nextPutAll: 'label: '. self storeLabelOn: aStream. aStream nextPutAll: return;
  1289.         nextPutAll: 'getLabel: '; store: labelMessage; nextPut: $); nextPutAll: return;
  1290.         nextPutAll: 'name: '; store: name; nextPutAll: continue;
  1291.         nextPutAll: 'insideColor: '. ExtendedStandardSystemView storeInsideColor: insideColor on: aStream.
  1292.             aStream nextPutAll: continue.
  1293.         ExtendedStandardSystemView storeBorderWidth: borderWidth messageOn: aStream.
  1294.             aStream nextPutAll: continue;
  1295.         nextPutAll: 'window: '; store: window; nextPutAll: continue;
  1296.         nextPutAll: 'transformation: ('; print: transformation; nextPut: $); nextPutAll: continue;
  1297.         nextPutAll: 'mode: '; store: self mode; nextPutAll: continue;
  1298.         nextPutAll: self fixedPointEncoding; nextPutAll: continue;
  1299.         nextPutAll: 'yourself)'! !
  1300. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1301.  
  1302. ExtendedPictureView class
  1303.     instanceVariableNames: ''!
  1304.  
  1305. !ExtendedPictureView class methodsFor: 'instance creation'!
  1306. on: anObject aspect: aSymbol label: aDisplayObjectOrNil getLabel: getLabelMessageOrNil
  1307.     "If the 'get label' message is nil, the supplied label is displayed (nil results in a picture with the view's inside color and border color). Otherwise, the 'get label' message is sent to the model to obtain the current label."
  1308.     ^(self new 
  1309.         model: anObject; aspect: aSymbol; label: aDisplayObjectOrNil; 
  1310.         selector: #isNil; arguments: #(); 
  1311.         mode: #constant; fixCenter)
  1312.             labelMessage: getLabelMessageOrNil! !
  1313.  
  1314.  
  1315. ExtendedSwitchView subclass: #ExtendedSwitchAndPictureView
  1316.     instanceVariableNames: 'labelSwitchPathName labelSeparation labelPictureString '
  1317.     classVariableNames: ''
  1318.     poolDictionaries: ''
  1319.     category: 'WindowMakerSupport'!
  1320.  
  1321. !ExtendedSwitchAndPictureView methodsFor: 'label/highlight modification'!
  1322. highlight: aDisplayObjectOrSymbol
  1323.     "The highlight must be made the same size as the label to properly overlap (they are centered in their display boxes)."
  1324.     super highlight: aDisplayObjectOrSymbol. "sets the user supplied highlight"
  1325.     highlightForm _ self getHighlight "recomputes it to properly overlap the label"!
  1326. label: anArray
  1327.     "Label is constructed from anArray of form #(switchPathName separation pictureString)."
  1328.     | savedForm |
  1329.     labelSource _ anArray.
  1330.     labelSwitchPathName _ anArray at: 1.
  1331.     labelSeparation _ anArray at: 2.
  1332.     labelPictureString _ anArray at: 3.
  1333.     labelSourceForm _ FormLibrarian formForPathName: labelSwitchPathName.
  1334.     savedForm _ labelSourceForm.
  1335.     super label: self getLabel. "label: destroys labelSource and labelSourceForm"
  1336.     labelSource _ anArray.
  1337.     labelSourceForm _ savedForm! !
  1338.  
  1339. !ExtendedSwitchAndPictureView methodsFor: 'printing'!
  1340. storeLabelOn: aStream
  1341.     "Stores the label in the form #(switchPathName separation pictureString)."
  1342.     labelSource isNil
  1343.         ifTrue: [super storeLabelOn: aStream]
  1344.         ifFalse: [labelSource storeOn: aStream]! !
  1345.  
  1346. !ExtendedSwitchAndPictureView methodsFor: 'private'!
  1347. getHighlight
  1348.     "Constructs a  highlight that parallels the label in size."
  1349.  
  1350.     | combinedForm |
  1351.     highlightForm isNil ifTrue: [^nil].
  1352.     combinedForm _ Form extent: label extent.
  1353.     highlightForm displayOn: combinedForm 
  1354.         at: 0@((combinedForm height - highlightForm height) // 2).
  1355.     ^combinedForm!
  1356. getLabel
  1357.     "Constructs a form from the switch path name, separation, and picture string."
  1358.  
  1359.     | switchForm pictureForm width height combinedForm |
  1360.     switchForm _ labelSourceForm isNil ifTrue: [Form extent: 0@0] ifFalse: [labelSourceForm].
  1361.     pictureForm _ labelPictureString asParagraph asForm.
  1362.  
  1363.     width _ switchForm width + labelSeparation + pictureForm width.
  1364.     height _ switchForm height max: pictureForm height.
  1365.     combinedForm _ Form extent: width@height.
  1366.  
  1367.     switchForm displayOn: combinedForm 
  1368.         at: 0@((height - switchForm height) // 2).
  1369.     pictureForm displayOn: combinedForm 
  1370.         at: (switchForm width + labelSeparation)@((height - pictureForm height) // 2).
  1371.  
  1372.     ^combinedForm! !
  1373.  
  1374. Smalltalk garbageCollect!
  1375.  
  1376. TextView subclass: #ExtendedTextView
  1377.     instanceVariableNames: 'name aspect updateInProgress '
  1378.     classVariableNames: ''
  1379.     poolDictionaries: ''
  1380.     category: 'WindowMakerSupport'!
  1381.  
  1382. !ExtendedTextView methodsFor: 'name'!
  1383. name
  1384.     ^name!
  1385. name: aSymbolOrNil
  1386.     name _ aSymbolOrNil!
  1387. viewNamed: aSymbol
  1388.     name == aSymbol ifTrue: [^self] ifFalse: [^nil]! !
  1389.  
  1390. !ExtendedTextView methodsFor: 'model'!
  1391. models: anObject
  1392.     "If this view's model is nil, changes it to anObject; otherwise, does nothing."
  1393.     model isNil ifFalse: [^self].
  1394.     self model: anObject!
  1395. resetModels
  1396.     "Sets this view's model to nil."
  1397.     self model: nil! !
  1398.  
  1399. !ExtendedTextView methodsFor: 'updating'!
  1400. aspect: aSymbol
  1401.     aspect _ aSymbol!
  1402. update: aSymbol
  1403.     "Upward compatible with text views; i.e. missing aspect results in using the partMsg selector instead."
  1404.     | actualAspect |
  1405.     updateInProgress isNil ifFalse: [^self].
  1406.     updateInProgress _ true.
  1407.         actualAspect _ aspect isNil 
  1408.             ifTrue: [(partMsg isKindOf: Message) ifTrue: [partMsg selector] ifFalse: [partMsg]]
  1409.             ifFalse: [aspect].
  1410.         actualAspect == aSymbol ifTrue: [super update: partMsg].
  1411.     updateInProgress _ nil! !
  1412.  
  1413. !ExtendedTextView methodsFor: 'adaptor'!
  1414. accept: aText from: aController
  1415.     (acceptMsg isKindOf: Message) 
  1416.         ifTrue: [^acceptMsg sendTo: model replacingParameter: 1 by: aText].
  1417.     ^super accept: aText from: aController!
  1418. getText
  1419.     (partMsg isKindOf: Message) ifTrue: [^partMsg sendTo: model].
  1420.     ^super getText!
  1421. yellowButtonMenu
  1422.     (menuMsg isKindOf: Message) ifTrue: [^menuMsg sendTo: model].
  1423.     ^super yellowButtonMenu! !
  1424.  
  1425. !ExtendedTextView methodsFor: 'copying'!
  1426. deepCopy
  1427.     ^self shallowCopy
  1428.         superView: nil; resetSubViews;
  1429.         model: model deepCopy controller: nil;
  1430.         transformation: transformation "stores a copy";
  1431.         window: window "stores a copy";
  1432.         yourself! !
  1433.  
  1434. !ExtendedTextView methodsFor: 'displaying'!
  1435. computeDisplayTransformation
  1436.     "Since the borders in the containing view do not actually scale, this view (if left unchanged) will be positioned at a point that assumes the borders did scale. This can be eliminated by transforming into the inset display box rather than the display box. See View | computeDisplayTransformation for the difference."
  1437.  
  1438.     self isTopView
  1439.         ifTrue: [^transformation]
  1440.         ifFalse: [^superView insetDisplayTransformation compose: transformation]!
  1441. insetDisplayTransformation
  1442.     "Ignores the borders."
  1443.     ^WindowingTransformation
  1444.         window: self insetWindow
  1445.         viewport: self insetDisplayBox! !
  1446.  
  1447. !ExtendedTextView methodsFor: 'printing'!
  1448. storeOn: aStream
  1449.     self storeOn: aStream indent: 2!
  1450. storeOn: aStream indent: indentation
  1451.     "Store this instance of an ExtendedTextView with indentation for readability."
  1452.     | return continue |
  1453.     return _ (WriteStream on: (String new: 16)) crtab: indentation; contents.
  1454.     continue _ ';', return.
  1455.     aStream
  1456.         nextPutAll: '((ExtendedTextView on: nil'; nextPutAll: return;
  1457.         nextPutAll: 'aspect: '; store: aspect; nextPutAll: return;
  1458.         nextPutAll: 'get: '; store: partMsg; nextPutAll: return;
  1459.         nextPutAll: 'change: '; store: acceptMsg; nextPutAll: return;
  1460.         nextPutAll: 'menu: '; store: menuMsg; nextPut: $); nextPutAll: return;
  1461.         nextPutAll: 'name: '; store: name; nextPutAll: continue;
  1462.         nextPutAll: 'insideColor: '. ExtendedStandardSystemView storeInsideColor: insideColor on: aStream.
  1463.             aStream nextPutAll: continue.
  1464.         ExtendedStandardSystemView storeBorderWidth: borderWidth messageOn: aStream.
  1465.             aStream nextPutAll: continue;
  1466.         nextPutAll: 'window: '; store: window; nextPutAll: continue;
  1467.         nextPutAll: 'transformation: ('; print: transformation; nextPut: $); nextPutAll: continue;
  1468.         nextPutAll: 'yourself)'! !
  1469. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1470.  
  1471. ExtendedTextView class
  1472.     instanceVariableNames: ''!
  1473.  
  1474. !ExtendedTextView class methodsFor: 'instance creation'!
  1475. on: anObject aspect: aSymbol get: getMsg change: changeMsg menu: menuMsg
  1476.     ^(super on: anObject aspect: getMsg change: changeMsg menu: menuMsg) 
  1477.         aspect: aSymbol! !
  1478.  
  1479.  
  1480. View subclass: #ExtendedView
  1481.     instanceVariableNames: 'name encoding '
  1482.     classVariableNames: ''
  1483.     poolDictionaries: ''
  1484.     category: 'WindowMakerSupport'!
  1485.  
  1486. !ExtendedView methodsFor: 'name'!
  1487. name
  1488.     ^name!
  1489. name: aSymbolOrNil
  1490.     name _ aSymbolOrNil!
  1491. viewNamed: aSymbol
  1492.     | answer |
  1493.     name == aSymbol ifTrue: [^self].
  1494.     subViews do: [:aView | 
  1495.         answer _ aView viewNamed: aSymbol. 
  1496.         answer isNil ifFalse: [^answer]].
  1497.     ^nil! !
  1498.  
  1499. !ExtendedView methodsFor: 'model'!
  1500. models: anObject
  1501.     "If this view's model is nil, changes it to anObject and repeats the process for all subviews; otherwise, does nothing."
  1502.     model isNil ifFalse: [^self].
  1503.     self model: anObject.
  1504.     subViews do: [:aView | aView models: anObject]!
  1505. resetModels
  1506.     "Sets this view's model to nil and repeats for all subviews."
  1507.     self model: nil.
  1508.     subViews do: [:aView | aView resetModels]! !
  1509.  
  1510. !ExtendedView methodsFor: 'encoding'!
  1511. encoding
  1512.     ^encoding!
  1513. encoding: anArray
  1514.     encoding _ anArray! !
  1515.  
  1516. !ExtendedView methodsFor: 'copying'!
  1517. deepCopy
  1518.     | copy |
  1519.     copy _ self shallowCopy
  1520.         superView: nil; resetSubViews;
  1521.         model: model deepCopy controller: nil;
  1522.         transformation: transformation "stores a copy";
  1523.         window: window "stores a copy";
  1524.         yourself.
  1525.     subViews do: [:aView | copy addSubView: aView deepCopy].
  1526.     ^copy! !
  1527.  
  1528. !ExtendedView methodsFor: 'displaying'!
  1529. computeDisplayTransformation
  1530.     "Since the borders in the containing view do not actually scale, this view (if left unchanged) will be positioned at a point that assumes the borders did scale. This can be eliminated by transforming into the inset display box rather than the display box. See View | computeDisplayTransformation for the difference."
  1531.  
  1532.     self isTopView
  1533.         ifTrue: [^transformation]
  1534.         ifFalse: [^superView insetDisplayTransformation compose: transformation]!
  1535. insetDisplayTransformation
  1536.     "Ignores the borders."
  1537.     ^WindowingTransformation
  1538.         window: self insetWindow
  1539.         viewport: self insetDisplayBox! !
  1540.  
  1541. !ExtendedView methodsFor: 'printing'!
  1542. storeOn: aStream
  1543.     self storeOn: aStream indent: 2!
  1544. storeOn: aStream encoding: aStringOrNil subViews: aBoolean indent: indentation
  1545.     "Store this ExtendedStandardSystemView using indentation for readability. Either generates the encoding or uses the one provided if aStringOrNil is non-nil. Only generates the subviews if aBoolean is true."
  1546.  
  1547.     | return continue |
  1548.     return _ (WriteStream on: (String new: 16)) crtab: indentation; contents.
  1549.     continue _ ';', return.
  1550.  
  1551.     aStream
  1552.         nextPutAll: '(ExtendedView new'; nextPutAll: return;
  1553.         nextPutAll: 'name: '; store: name; nextPutAll: continue;
  1554.         nextPutAll: 'encoding: '.
  1555.  
  1556.     aStringOrNil isNil
  1557.         ifTrue: [
  1558.             ExtendedStandardSystemView 
  1559.                 storeEncoding: encoding 
  1560.                 on: aStream indent: indentation+1]
  1561.         ifFalse: [aStream nextPutAll: aStringOrNil].
  1562.     aStream nextPutAll: continue.
  1563.  
  1564.     aStream
  1565.         nextPutAll: 'insideColor: '. ExtendedStandardSystemView storeInsideColor: insideColor on: aStream.
  1566.             aStream nextPutAll: continue.
  1567.         ExtendedStandardSystemView storeBorderWidth: borderWidth messageOn: aStream.
  1568.             aStream nextPutAll: continue;
  1569.         nextPutAll: 'window: '; store: window; nextPutAll: continue;
  1570.         nextPutAll: 'transformation: ('; print: transformation; nextPut: $); nextPutAll: continue.
  1571.  
  1572.     aBoolean ifTrue: [
  1573.         subViews do: [:subView | 
  1574.             aStream nextPutAll: 'addSubView: '.
  1575.             subView storeOn: aStream indent: indentation+1.
  1576.             aStream nextPutAll: continue]].
  1577.  
  1578.     aStream nextPutAll: 'yourself)'!
  1579. storeOn: aStream indent: indentation
  1580.     "Store this instance of an ExtendedView with indentation for readability."
  1581.     self storeOn: aStream encoding: nil subViews: true indent: indentation! !
  1582.  
  1583. !ExtendedView methodsFor: 'compiling'!
  1584. compileIntoClass: class method: methodName category: categoryName
  1585.     "Compile the receiver into the specified class."
  1586.     ExtendedStandardSystemView 
  1587.         compile: self intoClass: class method: methodName category: categoryName!
  1588. compileIntoClass: class method: methodName category: categoryName overflow: overflowName
  1589.     "Compile the receiver into the specified class."
  1590.     ExtendedStandardSystemView 
  1591.         compile: self intoClass: class method: methodName 
  1592.         category: categoryName overFlowCategory: overflowName! !
  1593.  
  1594.  
  1595. Object subclass: #FormLibrarian
  1596.     instanceVariableNames: 'libraries librariesSelection library librarySelection '
  1597.     classVariableNames: 'KnownLibraries '
  1598.     poolDictionaries: ''
  1599.     category: 'WindowMakerSupport'!
  1600.  
  1601. !FormLibrarian methodsFor: 'instance initialization'!
  1602. initialize
  1603.     libraries _ FormLibrarian allLibraries.
  1604.     librariesSelection _ nil.
  1605.     library _ nil.
  1606.     librarySelection _ nil! !
  1607.  
  1608. !FormLibrarian methodsFor: 'libraries window messages'!
  1609. changeLibrariesSelection: aStringOrNil
  1610.     librariesSelection = aStringOrNil ifTrue: [^self].
  1611.     librariesSelection _ aStringOrNil.
  1612.     library _ librariesSelection isNil
  1613.         ifTrue: [nil]
  1614.         ifFalse: [libraries at: librariesSelection asSymbol].
  1615.     librarySelection _ nil.
  1616.     self changed: #library.
  1617.     self changed: #pictures!
  1618. getLibrariesList
  1619.     ^libraries keys asSortedCollection asArray!
  1620. getLibrariesSelection
  1621.     ^librariesSelection!
  1622. getLibrariesYellowMenu
  1623.     ^ActionMenu
  1624.         labels: 'add library\delete library' withCRs
  1625.         lines: #()
  1626.         selectors: #(addLibrary deleteLibrary)! !
  1627.  
  1628. !FormLibrarian methodsFor: 'library window messages'!
  1629. changeLibrarySelection: aStringOrNil
  1630.     librarySelection = aStringOrNil ifTrue: [^self].
  1631.     librarySelection _ aStringOrNil.
  1632.     self changed: #pictures!
  1633. getLibraryList
  1634.     librariesSelection isNil
  1635.         ifTrue: [^Array new]
  1636.         ifFalse: [^library keys asSortedCollection asArray]!
  1637. getLibrarySelection
  1638.     ^librarySelection!
  1639. getLibraryYellowMenu
  1640.     ^ActionMenu
  1641.         labels: 'create white off- and on-forms\create off- and on-forms by copying selection\copy off-form to on-form\copy on-form to off-form\delete off- and on-forms\edit off-form\edit on-form' withCRs
  1642.         lines: #(2 4 5)
  1643.         selectors: #(createWhiteOffAndOnForms createOffAndOnFormsFromSelection copyOffFormToOnForm copyOnFormToOffForm deleteOffAndOnForms editOffForm editOnForm)! !
  1644.  
  1645. !FormLibrarian methodsFor: 'picture windows messages'!
  1646. getOffForm
  1647.     librarySelection isNil
  1648.         ifTrue: [^Form extent: 0@0]
  1649.         ifFalse: [^library at: librarySelection]!
  1650. getOnForm
  1651.     | offForm |
  1652.     librarySelection isNil
  1653.         ifTrue: [^Form extent: 0@0]
  1654.         ifFalse: [
  1655.             offForm _ library at: librarySelection.
  1656.             (offForm respondsTo: #highlight)
  1657.                 ifTrue: [^offForm highlight]
  1658.                 ifFalse: [^Form extent: 0@0]]! !
  1659.  
  1660. !FormLibrarian methodsFor: 'libraries window menu messages'!
  1661. addLibrary
  1662.     | newName |
  1663.     newName _ self newLibraryNameAndIfNone: [^nil].
  1664.     libraries at: newName put: (library _ FormLibrary new name: newName).
  1665.     KnownLibraries at: newName put: library.
  1666.     librariesSelection _ newName.
  1667.     librarySelection _ nil.
  1668.     self changed: #libraries.
  1669.     self changed: #library.
  1670.     self changed: #pictures!
  1671. deleteLibrary
  1672.     | newName |
  1673.     self verifyLibrarySelectionAndIfNone: [^nil].
  1674.     KnownLibraries
  1675.         removeKey: librariesSelection
  1676.         ifAbsent: [
  1677.             self confirm: 'cannot delete since not owned by librarian. Proceed to cancel'. 
  1678.             ^nil].
  1679.     libraries removeKey: librariesSelection ifAbsent: [].
  1680.     librariesSelection _ nil.
  1681.     library _ nil.
  1682.     librarySelection _ nil.
  1683.     self changed: #libraries.
  1684.     self changed: #library.
  1685.     self changed: #pictures! !
  1686.  
  1687. !FormLibrarian methodsFor: 'libraries window menu messages support'!
  1688. newLibraryNameAndIfNone: aBlock
  1689.     "Returns a name for a new library; an empty string indicates cancellation. If this name is already in use, reports the problem and repeats the process unless the user elects to quit (in this case, returns the result of executing the block)." 
  1690.     | request newName oldName |
  1691.  
  1692.     oldName _ 'unusedName'.
  1693.     request _ [
  1694.         oldName _ FillInTheBlank 
  1695.             request: 'Specify a name for the new library' 
  1696.             initialAnswer: oldName.
  1697.         oldName size = 0 ifTrue: [^aBlock value "cancel requested"].
  1698.         oldName].
  1699.  
  1700.     [libraries includesKey: (newName _ request value asSymbol)] whileTrue: [
  1701.         (self confirm: 'Name already exists. Try again?') ifFalse: [^aBlock value]].
  1702.  
  1703.     ^newName!
  1704. verifyLibrarySelectionAndIfNone: aBlock
  1705.     "If no library has been selected, complains and executes the block." 
  1706.  
  1707.     librariesSelection isNil ifTrue: [
  1708.         self confirm: 'You must first select a library\Try again.'.
  1709.         aBlock value]! !
  1710.  
  1711. !FormLibrarian methodsFor: 'library window menu messages'!
  1712. copyOffFormToOnForm
  1713.     | offForm |
  1714.     self verifyFormSelectionAndIfNone: [^nil].
  1715.     offForm _ self selectedForm.
  1716.     (offForm isKindOf: FormWithHighlight)
  1717.         ifTrue: [offForm highlight: offForm asForm]
  1718.         ifFalse: [offForm become: ((FormWithHighlight from: offForm) highlight: offForm deepCopy)]. 
  1719.     self changed: #pictures!
  1720. copyOnFormToOffForm
  1721.     | offForm |
  1722.     self verifyFormSelectionAndIfNone: [^nil].
  1723.     offForm _ self selectedForm.
  1724.     (offForm isKindOf: FormWithHighlight)
  1725.         ifTrue: [
  1726.             offForm extent: offForm highlight extent.
  1727.             offForm offset: offForm highlight offset.
  1728.             offForm bits: offForm highlight bits deepCopy]
  1729.         ifFalse: [offForm white "there isn't any on form"]. 
  1730.     self changed: #pictures!
  1731. createOffAndOnFormsFromSelection
  1732.     | newName |
  1733.     self verifyFormSelectionAndIfNone: [^nil].
  1734.     newName _ self newFormNameAndIfNone: [^nil].
  1735.  
  1736.     library at: newName put: (library at: librarySelection) deepCopy.
  1737.     librarySelection _ newName.
  1738.     self changed: #library!
  1739. createWhiteOffAndOnForms
  1740.     | newName size |
  1741.  
  1742.     (self confirm: 'You will be prompted with the form name\and then for the size of the form to be used.\Continue?' withCRs) ifFalse: [^nil].
  1743.  
  1744.     newName _ self newFormNameAndIfNone: [^nil].
  1745.  
  1746.     (self confirm: 'The form size can be specified as a point or interactively.\The interactive approach is less accurate.\Do you wish to specify it as a point?' withCRs)
  1747.         ifTrue: [size _ Compiler evaluate: (FillInTheBlank request: 'Form size?' initialAnswer: '16@16')]
  1748.         ifFalse: [size _ Rectangle fromUser extent].
  1749.  
  1750.     library at: newName put: (FormWithHighlight extent: size highlight: (Form extent: size)).
  1751.     self changed: #library.
  1752.     self changed: #pictures!
  1753. deleteOffAndOnForms
  1754.     self verifyFormSelectionAndIfNone: [^nil].
  1755.     library removeKey: librarySelection.
  1756.     librarySelection _ nil.
  1757.     self changed: #library.
  1758.     self changed: #pictures!
  1759. editOffForm
  1760.     self verifyFormSelectionAndIfNone: [^nil].
  1761.     (library at: librarySelection) bitEdit.
  1762.     self changed: #pictures!
  1763. editOnForm
  1764.     | offForm |
  1765.     self verifyFormSelectionAndIfNone: [^nil].
  1766.     offForm _ self selectedForm.
  1767.     (offForm isKindOf: FormWithHighlight)
  1768.         ifFalse: [offForm become: ((FormWithHighlight from: offForm) 
  1769.             highlight: (offForm deepCopy white))]. 
  1770.     offForm highlight bitEdit.
  1771.     self changed: #pictures! !
  1772.  
  1773. !FormLibrarian methodsFor: 'library window menu messages support'!
  1774. newFormNameAndIfNone: aBlock
  1775.     "Returns a name for a new form; an empty string indicates cancellation. If this name is already in use, reports the problem and repeats the process unless the user elects to quit (in this case, returns the result of executing the block)." 
  1776.     | request newName oldName |
  1777.  
  1778.     oldName _ 'unusedName'.
  1779.     request _ [
  1780.         oldName _ FillInTheBlank 
  1781.             request: 'Specify a name for the new form' 
  1782.             initialAnswer: oldName.
  1783.         oldName size = 0 ifTrue: [^aBlock value "cancel requested"].
  1784.         oldName].
  1785.  
  1786.     [library includesKey: (newName _ request value asSymbol)] whileTrue: [
  1787.         (self confirm: 'Name already exists. Try again?') ifFalse: [^aBlock value]].
  1788.  
  1789.     ^newName!
  1790. verifyFormSelectionAndIfNone: aBlock
  1791.     "If no form has been selected, complains and executes the block." 
  1792.  
  1793.     librarySelection isNil ifTrue: [
  1794.         self confirm: 'You must first select a form\Try again.'.
  1795.         aBlock value]! !
  1796.  
  1797. !FormLibrarian methodsFor: 'external queries'!
  1798. selectedForm
  1799.     librarySelection isNil
  1800.         ifTrue: [^nil]
  1801.         ifFalse: [^library at: librarySelection]!
  1802. selectedFormName
  1803.     ^librarySelection!
  1804. selectedLibrary
  1805.     ^library!
  1806. selectedLibraryName
  1807.     ^librariesSelection!
  1808. selectedPathName
  1809.     "Returns nil or a pair denoting #(libraryName formName)."
  1810.     librarySelection isNil
  1811.         ifTrue: [^nil]
  1812.         ifFalse: [^Array with: library name with: librarySelection]! !
  1813.  
  1814. !FormLibrarian methodsFor: 'external modification'!
  1815. library: libraryName form: formName
  1816.     librariesSelection _ libraryName asSymbol.
  1817.     library _ librariesSelection isNil ifTrue: [nil] ifFalse: [libraries at: librariesSelection].
  1818.     librarySelection _ formName asSymbol!
  1819. selectedPathName: path
  1820.     "Changes the current path so that views on the librarian displays these as the current selections."
  1821.     librariesSelection _ (path at: 1) asSymbol.
  1822.     library _ libraries at: librariesSelection.
  1823.     librarySelection _ (path at: 2) asSymbol! !
  1824. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1825.  
  1826. FormLibrarian class
  1827.     instanceVariableNames: ''!
  1828.  
  1829. !FormLibrarian class methodsFor: 'class initialization'!
  1830. compress
  1831.     "FormLibrarian compress"
  1832.     | time | 
  1833.     Transcript cr; show: 'Compressing'.
  1834.     time _ WindowMakerMasterIconController timeFor: [
  1835.         #(topView subView) do: [:viewName |
  1836.             Transcript show: ' ', viewName, '.... '.
  1837.             ExtendedStandardSystemView 
  1838.                 compileEncoding: (WindowMaker asView: (self perform: viewName)) 
  1839.                 intoClass: FormLibrarian class
  1840.                 method: viewName category: 'view']].
  1841.     Transcript cr; show: 'Total time ', time, '.'; cr!
  1842. decompress
  1843.     "FormLibrarian decompress"
  1844.     | time view |
  1845.     Transcript cr.
  1846.     time _ WindowMakerMasterIconController timeFor: [
  1847.         #(subView topView) do: [:viewName |
  1848.             Transcript show: 'Decoding FormLibrarian ', viewName, ' ....'.
  1849.             time _ WindowMakerMasterIconController timeFor: [
  1850.                 "Explicitly re-encode the view in case hand modifications to the encoding were done."
  1851.                 view _ WindowMaker asView: (WindowMaker asView: (self perform: viewName)) encoding].
  1852.             Transcript show: ' done in ', time, '.'; cr.
  1853.  
  1854.             Transcript tab; show: 'Compiling FormLibrarian ', viewName, ' ....'.
  1855.             time _ WindowMakerMasterIconController timeFor: [
  1856.                 view 
  1857.                     compileIntoClass: FormLibrarian class 
  1858.                     method: viewName category: 'view'].
  1859.             Transcript show:' done in ', time, '.'; cr]].
  1860.     Transcript show: 'Total time ', time, '.'; cr!
  1861. initialize
  1862.     "FormLibrarian initialize"
  1863.  
  1864.     KnownLibraries isNil ifTrue: [KnownLibraries _ IdentityDictionary new]!
  1865. reInitialize
  1866.     "FormLibrarian reInitialize"
  1867.  
  1868.     KnownLibraries _ IdentityDictionary new! !
  1869.  
  1870. !FormLibrarian class methodsFor: 'instance creation'!
  1871. new
  1872.     ^super new initialize! !
  1873.  
  1874. !FormLibrarian class methodsFor: 'querying'!
  1875. allLibraries
  1876.     "FormLibrarian allLibraries inspect"
  1877.     | result |
  1878.     result _ IdentityDictionary new.
  1879.     FormLibrary allInstances do: [:aLibrary |
  1880.         result at: aLibrary name put: aLibrary].
  1881.     ^result!
  1882. formForLibraryName: libraryName formName: formName
  1883.     ^(self libraryForName: libraryName)
  1884.         at: formName asSymbol
  1885.         ifAbsent: [self error: 'library ', libraryName, 
  1886.             ' does not contain form name ', formName]!
  1887. formForPathName: path
  1888.     ^self formForLibraryName: (path at: 1) formName: (path at: 2)!
  1889. libraryForName: libraryName
  1890.     | librarySymbol |
  1891.     librarySymbol _ libraryName asSymbol.
  1892.     FormLibrary allInstances do: [:aLibrary |
  1893.         aLibrary name == librarySymbol ifTrue: [^aLibrary]].
  1894.     self error: 'library ', librarySymbol, ' does not exist'!
  1895. pathNameForForm: aForm
  1896.     FormLibrary allInstances do: [:aLibrary |
  1897.         aLibrary keys do: [:key |
  1898.             (aLibrary at: key) == aForm 
  1899.                 ifTrue: [^Array with: aLibrary name with: key asSymbol]]].
  1900.     ^nil! !
  1901.  
  1902. !FormLibrarian class methodsFor: 'editing'!
  1903. edit
  1904.     "FormLibrarian edit"
  1905.     WindowMaker open: self topView on: FormLibrarian new! !
  1906.  
  1907. !FormLibrarian class methodsFor: 'view'!
  1908. subView
  1909.     "Returns an initialized view."
  1910.     | anArray |
  1911.  
  1912.     anArray _ "WindowMaker edit:" #(Master librarian (-222 -179 222 180) white
  1913.         0 (1.43652 1.2647 320.0 227.039) false nil (nil) (nil) (250 100) (1000
  1914.         1000) (classMethod notEncoded FormLibrarian view subView 'view overflow')
  1915.         ((Menu nil (-222.0 -179.0 -74.0 180.0) white (0 0 1 0) (libraries (getLibrariesList)
  1916.         (getLibrariesSelection) (changeLibrariesSelection: aSelectionObject) (getLibrariesYellowMenu)))
  1917.         (Menu nil (-74.0 -179.0 78.0 180.0) white (0 0 1 0) (library (getLibraryList)
  1918.         (getLibrarySelection) (changeLibrarySelection: aSelectionObject) (getLibraryYellowMenu)))
  1919.         (Picture nil (143.0 87.0 158.0 102.0) white 0 (form DefaultFormLibrary
  1920.         button) (lockedConstant fixCenter 0) (pictures (getOnForm))) (Picture
  1921.         nil (143.0 -88.0 158.0 -73.0) white 0 (form DefaultFormLibrary button)
  1922.         (lockedConstant fixCenter 0) (pictures (getOffForm))) (Picture nil (78.0
  1923.         -179.0 222.0 -142.0) white (0 0 0 1) (text 'off form') (varying) (nil
  1924.         (nil))) (Picture nil (78.0 -3.0 222.0 34.0) white (0 1 0 1) (text 'on form')
  1925.         (varying) (nil (nil))))).
  1926.     ^anArray!
  1927. topView
  1928.     "Returns an initialized view."
  1929.     | anArray |
  1930.  
  1931.     anArray _ "WindowMaker edit:" #(Master nil (-286 -201 286 201) white 2
  1932.         (1.11518 1.12944 320.0 227.599) true 'Librarian' (nil) (nil) (0 0) (1000
  1933.         1000) (classMethod notEncoded FormLibrarian view topView 'view overflow')
  1934.         ((External nil (-284.0 -199.0 284.0 199.0) nil 0 (FormLibrarian subView)))).
  1935.     ^anArray! !
  1936.  
  1937.  
  1938.  
  1939.  
  1940.  
  1941. Object subclass: #FormLibrary
  1942.     instanceVariableNames: 'name dictionary '
  1943.     classVariableNames: 'DefaultFormLibrary '
  1944.     poolDictionaries: ''
  1945.     category: 'WindowMakerSupport'!
  1946.  
  1947. !FormLibrary methodsFor: 'instance initialization'!
  1948. initialize
  1949.     dictionary _ IdentityDictionary new! !
  1950.  
  1951. !FormLibrary methodsFor: 'naming'!
  1952. name
  1953.     ^name!
  1954. name: aString
  1955.     name _ aString asSymbol! !
  1956.  
  1957. !FormLibrary methodsFor: 'access and modification'!
  1958. at: key
  1959.     ^dictionary at: key asSymbol!
  1960. at: key ifAbsent: aBlock
  1961.     ^dictionary at: key asSymbol ifAbsent: aBlock!
  1962. at: key put: aForm
  1963.     ^dictionary at: key asSymbol put: aForm! !
  1964.  
  1965. !FormLibrary methodsFor: 'printing'!
  1966. printOn: aStream
  1967.     aStream nextPutAll: 'FormLibrary '; nextPutAll: name; space.
  1968.     dictionary printOn: aStream! !
  1969.  
  1970. !FormLibrary methodsFor: 'operations normally inherited'!
  1971. includesKey: aKey
  1972.     ^dictionary includesKey: aKey!
  1973. keys
  1974.     ^dictionary keys!
  1975. removeKey: aKey
  1976.     ^dictionary removeKey: aKey! !
  1977. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1978.  
  1979. FormLibrary class
  1980.     instanceVariableNames: ''!
  1981.  
  1982. !FormLibrary class methodsFor: 'class initialization'!
  1983. initialize
  1984.     "FormLibrary initialize"
  1985.  
  1986.     DefaultFormLibrary isNil ifTrue: [
  1987.         DefaultFormLibrary _ FormLibrary new name: #DefaultFormLibrary.
  1988.         DefaultFormLibrary 
  1989.             at: #blank 
  1990.             put: ((FormWithHighlight extent: 15@15) highlight: (Form extent: 15@15)).
  1991.         DefaultFormLibrary 
  1992.             at: #button 
  1993.             put: ((FormWithHighlight
  1994.                 extent: 15@15
  1995.                 fromArray: #(0 1984 6192 12312 8200 16388 16388 16388 16388 16388 8200 
  1996.                     12296 6192 1984 0)
  1997.                 offset: 0@0) 
  1998.                     highlight: (Form
  1999.                         extent: 15@15
  2000.                         fromArray: #(0 1984 6192 12312 8200 17284 18372 18372 18372 
  2001.                             17284 8200 12312 6192 1984 0)
  2002.                         offset: 0@0)).
  2003.         DefaultFormLibrary 
  2004.             at: #check 
  2005.             put: ((FormWithHighlight
  2006.                 extent: 15@15
  2007.                 fromArray: #(65534 32770 32770 32770 32770 32770 32770 32770 32770 
  2008.                     32770 32770 32770 32770 32770 65534)
  2009.                 offset: 0@0) 
  2010.                     highlight: (Form
  2011.                         extent: 15@15
  2012.                         fromArray: #(65534 32770 32818 32818 32866 32866 32962 
  2013.                             32962 45442 45442 39682 40706 36354 33794 65534)
  2014.                         offset: 0@0))].!
  2015. reInitialize
  2016.     "FormLibrary reInitialize"
  2017.  
  2018.     DefaultFormLibrary _ nil.
  2019.     self initialize! !
  2020.  
  2021. !FormLibrary class methodsFor: 'instance creation'!
  2022. new
  2023.     ^super new initialize! !
  2024.  
  2025.  
  2026.  
  2027. Form subclass: #FormWithHighlight
  2028.     instanceVariableNames: 'highlight '
  2029.     classVariableNames: ''
  2030.     poolDictionaries: ''
  2031.     category: 'WindowMakerSupport'!
  2032.  
  2033. !FormWithHighlight methodsFor: 'access and modification'!
  2034. highlight
  2035.     ^highlight!
  2036. highlight: anotherForm
  2037.     highlight _ anotherForm! !
  2038.  
  2039. !FormWithHighlight methodsFor: 'copying'!
  2040. asForm
  2041.     ^(Form extent: self extent) 
  2042.         offset: self offset;
  2043.         bits: self bits deepCopy!
  2044. deepCopy
  2045.     ^super deepCopy highlight: highlight deepCopy! !
  2046.  
  2047. !FormWithHighlight methodsFor: 'printing'!
  2048. storeOn: aStream
  2049.     "Recreates the receiver assuming there is no circularity."
  2050.     aStream nextPut: $(. 
  2051.     super storeOn: aStream. 
  2052.     aStream nextPutAll: ' highlight: '.
  2053.     highlight storeOn: aStream.
  2054.     aStream nextPut: $).! !
  2055. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2056.  
  2057. FormWithHighlight class
  2058.     instanceVariableNames: ''!
  2059.  
  2060. !FormWithHighlight class methodsFor: 'instance creation'!
  2061. extent: aPoint highlight: aForm
  2062.     ^(self extent: aPoint) highlight: aForm!
  2063. from: aForm
  2064.     ^(self extent: aForm extent) 
  2065.         offset: aForm offset;
  2066.         bits: aForm bits deepCopy! !
  2067.  
  2068.  
  2069.